1079 files changed, 41752 insertions, 26401 deletions

diff --git a/.gitignore b/.gitignore
index 4f8c019f4..7434f6212 100644
--- a/.gitignore
+++ b/.gitignore
@@ -44,17 +44,18 @@ TAGS
 .pc
 bin/
 _build
-plugins/*/*_mod.ml
 myocamlbuild_config.ml
 config/Makefile
 config/coq_config.ml
 config/Info-*.plist
 dev/ocamldebug-coq
+dev/camlp4.dbg
 plugins/micromega/csdpcert
 kernel/byterun/dllcoqrun.so
 coqdoc.sty
-csdp.cache
-test-suite/lia.cache
+.csdp.cache
+test-suite/.lia.cache
+test-suite/.nra.cache
 test-suite/trace
 test-suite/misc/universes/all_stdlib.v
 test-suite/misc/universes/universes.txt
@@ -68,7 +69,7 @@ doc/faq/axioms.eps_t
 doc/faq/axioms.pdf
 doc/faq/axioms.pdf_t
 doc/faq/axioms.png
-doc/refman/csdp.cache
+doc/refman/.csdp.cache
 doc/refman/trace
 doc/refman/Reference-Manual.pdf
 doc/refman/Reference-Manual.ps
@@ -112,25 +113,21 @@ tools/coqwc.ml
 tools/coqdep_lexer.ml
 tools/ocamllibdep.ml
 tools/coqdoc/cpretty.ml
-lib/xml_lexer.ml
+ide/xml_lexer.ml
 
-# .ml4 files
+# .ml4 / .mlp files
 
 g_*.ml
 
 ide/project_file.ml
 parsing/compat.ml
-grammar/q_util.ml
-grammar/q_constr.ml
-grammar/tacextend.ml
-grammar/vernacextend.ml
-grammar/argextend.ml
 parsing/cLexer.ml
-tactics/hipattern.ml
 ltac/coretactics.ml
 ltac/extratactics.ml
 ltac/extraargs.ml
+ltac/profile_ltac_tactics.ml
 ide/coqide_main.ml
+plugins/ssrmatching/ssrmatching.ml
 
 # other auto-generated files
 
@@ -139,7 +136,11 @@ kernel/copcodes.ml
 tools/tolink.ml
 theories/Numbers/Natural/BigN/NMake_gen.v
 ide/index_urls.txt
-lia.cache
+.lia.cache
+checker/names.ml
+checker/names.mli
+checker/esubst.ml
+checker/esubst.mli
 
 # mlis documentation
 
@@ -157,4 +158,8 @@ dev/myinclude
 /doc/refman/Reference-Manual.hoptind
 /doc/refman/Reference-Manual.optidx
 /doc/refman/Reference-Manual.optind
+
 user-contrib
+.*.sw*
+test-suite/.lia.cache
+test-suite/.nra.cache
diff --git a/.mailmap b/.mailmap
index 13c71558f..51c8778f8 100644
--- a/.mailmap
+++ b/.mailmap
@@ -52,6 +52,7 @@ Pierre Letouzey <pierre.letouzey@inria.fr>         letouzey <letouzey@85f007b7-5
 Assia Mahboubi <assia.mahboubi@inria.fr>           amahboub <amahboub@85f007b7-540e-0410-9357-904b9bb8a0f7>
 Evgeny Makarov <emakarov@gforge>                   emakarov <emakarov@85f007b7-540e-0410-9357-904b9bb8a0f7>
 Gregory Malecha <gmalecha@eecs.harvard.edu>        Gregory Malecha <gmalecha@cs.harvard.edu>
+Gregory Malecha <gmalecha@eecs.harvard.edu>        Gregory Malecha <gmalecha@gmail.com>
 Lionel Elie Mamane <lmamane@gforge>                lmamane <lmamane@85f007b7-540e-0410-9357-904b9bb8a0f7>
 Claude Marché <marche@gforge>                      marche <marche@85f007b7-540e-0410-9357-904b9bb8a0f7>
 Micaela Mayero <mayero@gforge>                     mayero <mayero@85f007b7-540e-0410-9357-904b9bb8a0f7>
@@ -69,6 +70,8 @@ Pierre-Marie Pédrot <pierre-marie.pedrot@inria.fr> ppedrot <ppedrot@85f007b7-54
 Loïc Pottier <pottier@gforge>                      pottier <pottier@85f007b7-540e-0410-9357-904b9bb8a0f7>
 Matthias Puech <puech@gforge>                      puech <puech@85f007b7-540e-0410-9357-904b9bb8a0f7>
 Yann Régis-Gianas <yrg@pps.univ-paris-diderot.fr>  regisgia <regisgia@85f007b7-540e-0410-9357-904b9bb8a0f7>
+Daniel de Rauglaudre <daniel.de_rauglaudre@inria.fr> Daniel de Rauglaudre <daniel.de_rauglaudre@inria.fr>
+Daniel de Rauglaudre <daniel.de_rauglaudre@inria.fr> Daniel De Rauglaudre <ddr@gforge>
 Clément Renard <clrenard@gforge>                   clrenard <clrenard@85f007b7-540e-0410-9357-904b9bb8a0f7>
 Claudio Sacerdoti Coen <sacerdot@gforge>           sacerdot <sacerdot@85f007b7-540e-0410-9357-904b9bb8a0f7>
 Vincent Siles <vsiles@gforge>                      vsiles <vsiles@85f007b7-540e-0410-9357-904b9bb8a0f7>
@@ -79,7 +82,8 @@ Arnaud Spiwack <arnaud@spiwack.net>                aspiwack <aspiwack@85f007b7-5
 Enrico Tassi <Enrico.Tassi@inria.fr>               gareuselesinge <gareuselesinge@85f007b7-540e-0410-9357-904b9bb8a0f7>
 Enrico Tassi <Enrico.Tassi@inria.fr>               Enrico Tassi <enrico.tassi@inria.fr>
 Enrico Tassi <Enrico.Tassi@inria.fr>               Enrico Tassi <gares@fettunta.org>
-Laurent Théry <thery@gforge>                       thery <thery@85f007b7-540e-0410-9357-904b9bb8a0f7>
+Laurent Théry <laurent.thery@inria.fr>             thery <thery@85f007b7-540e-0410-9357-904b9bb8a0f7>
+Laurent Théry <laurent.thery@inria.fr>             thery <thery@sophia.inria.fr>
 Benjamin Werner <werner@gforge>                    werner <werner@85f007b7-540e-0410-9357-904b9bb8a0f7>
 
 # Anonymous accounts
diff --git a/.merlin b/.merlin
index 91dbc336b..bda18d549 100644
--- a/.merlin
+++ b/.merlin
@@ -1,7 +1,11 @@
-FLG -rectypes
+FLG -rectypes -thread
 
+S ltac
+B ltac
 S config
 B config
+S ide
+B ide
 S lib
 B lib
 S intf
@@ -26,8 +30,12 @@ S printing
 B printing
 S parsing
 B parsing
+S stm
+B stm
 S toplevel
 B toplevel
+S vernac
+B vernac
 
 S tools
 B tools
@@ -35,3 +43,5 @@ S tools/coqdoc
 B tools/coqdoc
 S dev
 B dev
+
+PKG threads.posix
diff --git a/.travis.yml b/.travis.yml
new file mode 100644
index 000000000..de16f2d0b
--- /dev/null
+++ b/.travis.yml
@@ -0,0 +1,119 @@
+dist: trusty
+sudo: required
+# Until Ocaml becomes a language, we set a known one.
+language: c
+cache:
+  apt: true
+  directories:
+  - $HOME/.opam
+addons:
+  apt:
+    sources:
+    - avsm
+    packages:
+    - opam
+    - aspcud
+    - gcc-multilib
+env:
+  global:
+  - NJOBS=2
+  # system is == 4.02.3
+  - COMPILER="system"
+  # Main test suites
+  matrix:
+  - TEST_TARGET="test-suite" COMPILER="4.02.3+32bit"
+  - TEST_TARGET="validate"                           TW="travis_wait"
+  - TEST_TARGET="validate"   COMPILER="4.02.3+32bit" TW="travis_wait"
+  - TEST_TARGET="ci-color"
+  - TEST_TARGET="ci-compcert"
+  - TEST_TARGET="ci-coquelicot"
+  - TEST_TARGET="ci-cpdt"
+  - TEST_TARGET="ci-geocoq"
+  - TEST_TARGET="ci-fiat-crypto"
+  - TEST_TARGET="ci-flocq"
+  - TEST_TARGET="ci-hott"
+  - TEST_TARGET="ci-iris-coq"
+  - TEST_TARGET="ci-math-classes"
+  - TEST_TARGET="ci-math-comp"
+  - TEST_TARGET="ci-sf"
+  - TEST_TARGET="ci-unimath"
+  # Not ready yet for 8.7
+  # - TEST_TARGET="ci-metacoq"
+  # - TEST_TARGET="ci-tlc"
+
+matrix:
+
+  allow_failures:
+  - env: TEST_TARGET="ci-cpdt"
+
+  # Full Coq test-suite with two compilers
+  # [TODO: use yaml refs and avoid duplication for packages list]
+  include:
+    - env:
+      - TEST_TARGET="test-suite"
+      - EXTRA_CONF="-coqide opt -with-doc yes"
+      - EXTRA_OPAM="lablgtk-extras hevea"
+      addons:
+        apt:
+          sources:
+          - avsm
+          packages:
+          - opam
+          - aspcud
+          - libgtk2.0-dev
+          - libgtksourceview2.0-dev
+          - texlive-latex-base
+          - texlive-latex-recommended
+          - texlive-latex-extra
+          - texlive-math-extra
+          - texlive-fonts-recommended
+          - texlive-fonts-extra
+          - latex-xcolor
+          - ghostscript
+          - transfig
+          - imagemagick
+    - env:
+      - TEST_TARGET="test-suite"
+      - COMPILER="4.04.0"
+      - EXTRA_CONF="-coqide opt -with-doc yes"
+      - EXTRA_OPAM="lablgtk-extras hevea"
+      addons:
+        apt:
+          sources:
+          - avsm
+          packages:
+          - opam
+          - aspcud
+          - libgtk2.0-dev
+          - libgtksourceview2.0-dev
+          - texlive-latex-base
+          - texlive-latex-recommended
+          - texlive-latex-extra
+          - texlive-math-extra
+          - texlive-fonts-recommended
+          - texlive-fonts-extra
+          - latex-xcolor
+          - ghostscript
+          - transfig
+          - imagemagick
+
+install:
+- opam init -j ${NJOBS} --compiler=${COMPILER} -n -y
+- eval $(opam config env)
+- opam config var root
+- opam install -j ${NJOBS} -y camlp5 ocamlfind ${EXTRA_OPAM}
+- opam list
+
+script:
+
+- echo 'Configuring Coq...' && echo -en 'travis_fold:start:coq.config\\r'
+- ./configure -local -usecamlp5 -native-compiler yes ${EXTRA_CONF}
+- echo -en 'travis_fold:end:coq.config\\r'
+
+- echo 'Building Coq...' && echo -en 'travis_fold:start:coq.build\\r'
+- make -j ${NJOBS}
+- echo -en 'travis_fold:end:coq.build\\r'
+
+- echo 'Running tests...' && echo -en 'travis_fold:start:coq.test\\r'
+- ${TW} make -j ${NJOBS} ${TEST_TARGET}
+- echo -en 'travis_fold:end:coq.test\\r'
diff --git a/CHANGES b/CHANGES
index 9c89cdb8e..4a7cb8c45 100644
--- a/CHANGES
+++ b/CHANGES
@@ -1,11 +1,55 @@
-Changes beyond V8.5
+Changes beyond V8.6
 ===================
 
 Tactics
 
+- New tactic "extensionality in H" which applies (possibly dependent)
+  functional extensionality in H supposed to be a quantified equality
+  until giving a bare equality.
+
+Changes from V8.6beta1 to V8.6
+==============================
+
+Kernel
+
+- Fixed critical bug #5248 in VM long multiplication on 32-bit
+  architectures. Was there only since 8.6beta1, so no stable release impacted.
+
+Other bug fixes in universes, type class shelving,...
+
+Changes from V8.5 to V8.6beta1
+==============================
+
+Kernel
+
+- A new, faster state-of-the-art universe constraint checker.
+
+Specification language
+
+- Giving implicit arguments explicitly to a constant with multiple
+  choices of implicit arguments does not break any more insertion of
+  further maximal implicit arguments.
+- Ability to put any pattern in binders, prefixed by quote, e.g.
+  "fun '(a,b) => ...", "λ '(a,(b,c)), ...", "Definition foo '(x,y) := ...".
+  It expands into a "let 'pattern := ..."
+
+Tactics
+
 - Flag "Bracketing Last Introduction Pattern" is now on by default.
+- Flag "Regular Subst Tactic" is now on by default: it respects the
+  initial order of hypothesis, it contracts cycles, it unfolds no
+  local definitions (common source of incompatibilities, fixable by
+  "Unset Regular Subst Tactic").
+- New flag "Refolding Reduction", now disabled by default, which turns
+  on refolding of constants/fixpoints (as in cbn) during the reductions
+  done during type inference and tactic retyping. Can be extremely
+  expensive. When set off, this recovers the 8.4 behaviour of unification
+  and type inference. Potential source of incompatibility with 8.5 developments
+  (the option is set on in Compat/Coq85.v).
 - New flag "Shrink Abstract" that minimalizes proofs generated by the abstract
   tactical w.r.t. variables appearing in the body of the proof.
+  On by default and deprecated. Minor source of incompatibility
+  for code relying on the precise arguments of abstracted proofs.
 - Serious bugs are fixed in tactic "double induction" (source of
   incompatibilities as soon as the inductive types have dependencies in
   the type of their constructors; "double induction" remains however
@@ -18,23 +62,195 @@ Tactics
 - Every generic argument type declares a tactic scope of the form "name:(...)"
   where name is the name of the argument. This generalizes the constr: and ltac:
   instances.
+- When in strict mode (i.e. in a Ltac definition), if the "intro" tactic is
+  given a free identifier, it is not bound in subsequent tactics anymore.
+  In order to introduce a binding, use e.g. the "fresh" primitive instead
+  (potential source of incompatibilities).
+- New tactics is_ind, is_const, is_proj, is_constructor for use in Ltac.
+- New goal selectors.  Sets of goals can be selected by listing integers
+  ranges. Example: "1,4-7,24: tac" focuses "tac" on goals 1,4,5,6,7,24.
+- For uniformity with "destruct"/"induction" and for a more natural
+  behavior, "injection" can now work in place by activating option
+  "Structural Injection". In this case, hypotheses are also put in the
+  context in the natural left-to-right order and the hypothesis on
+  which injection applies is cleared.
+- Tactic "contradiction" (hence "easy") now also solve goals with
+  hypotheses of the form "~True" or "t<>t" (possible source of
+  incompatibilities because of more successes in automation, but
+  generally a more intuitive strategy).
+- Option "Injection On Proofs" was renamed "Keep Proof Equalities". When
+  enabled, injection and inversion do not drop equalities between objects
+  in Prop. Still disabled by default.
+- New tactics "notypeclasses refine" and "simple notypeclasses refine" that
+  disallow typeclass resolution when typechecking their argument, for use
+  in typeclass hints.
+- Integration of LtacProf, a profiler for Ltac.
+- Reduction tactics now accept more fine-grained flags: iota is now a shorthand
+  for the new flags match, fix and cofix.
+- The ssreflect subterm selection algorithm is now accessible to tactic writers
+  through the ssrmatching plugin.
+- When used as an argument of an ltac function, "auto" without "with"
+  nor "using" clause now correctly uses only the core hint database by
+  default.
+
+Hints
+
+- Revised the syntax of [Hint Cut] to follow standard notation for regexps.
+- Hint Mode now accepts "!" which means that the mode matches only if the
+  argument's head is not an evar (it goes under applications, casts, and
+  scrutinees of matches and projections).
+- Hints can now take an optional user-given pattern, used only by
+  [typeclasses eauto] with the [Filtered Unification] option on.
+
+Typeclasses
+
+- Many new options and new engine based on the proof monad. The
+  [typeclasses eauto] tactic is now a multi-goal, multi-success tactic.
+  See reference manual for more information. It is planned to
+  replace auto and eauto in the following version. The 8.5 resolution
+  engine is still available to help solve compatibility issues.
 
 Program
 
-- The "Shrink Obligations" flag now applies to all obligations, not only those
-  solved by the automatic tactic.
+- The "Shrink Obligations" flag now applies to all obligations, not only
+  those solved by the automatic tactic.
+- "Shrink Obligations" is on by default and deprecated. Minor source of
+  incompatibility for code relying on the precise arguments of
+  obligations.
 
 Notations
 
 - "Bind Scope" can once again bind "Funclass" and "Sortclass".
 
+General infrastructure
+
+- New configurable warning system which can be controlled with the vernacular
+  command "Set Warnings", or, under coqc/coqtop, with the flag "-w". In
+  particular, the default is now that warnings are printed by coqc.
+- In asynchronous mode, Coq is now capable of recovering from errors and
+  continue processing the document.
+
+Tools
+
+- coqc accepts a -o option to specify the output file name
+- coqtop accepts --print-version to print Coq and OCaml versions in
+  easy to parse format
+- Setting [Printing Dependent Evars Line] can be unset to disable the
+  computation associated with printing the "dependent evars: " line in
+  -emacs mode
+- Removed the -verbose-compat-notations flag and the corresponding Set
+  Verbose Compat vernacular, since these warnings can now be silenced or
+  turned into errors using "-w".
+
+XML protocol
+
+- message format has changed, see dev/doc/changes.txt for more details.
+
+Many bug fixes, minor changes and documentation improvements are not mentioned
+here.
+
+Changes from V8.5pl2 to V8.5pl3
+===============================
+
+Critical bugfix
+
+- #4876: Guard checker incompleteness when using primitive projections
+
+Other bugfixes
+
+- #4780: Induction with universe polymorphism on was creating ill-typed terms.
+- #4673: regression in setoid_rewrite, unfolding let-ins for type unification.
+- #4754: Regression in setoid_rewrite, allow postponed unification problems to remain.
+- #4769: Anomaly with universe polymorphic schemes defined inside sections.
+- #3886: Program: duplicate obligations of mutual fixpoints.
+- #4994: Documentation typo.
+- #5008: Use the "md5" command on OpenBSD.
+- #5007: Do not assume the "TERM" environment variable is always set.
+- #4606: Output a break before a list only if there was an empty line.
+- #5001: metas not cleaned properly in clenv_refine_in.
+- #2336: incorrect glob data for module symbols (bug #2336).
+- #4832: Remove extraneous dot in error message.
+- Anomaly in printing a unification error message.
+- #4947: Options which take string arguments are not backwards compatible.
+- #4156: micromega cache files are now hidden files.
+- #4871: interrupting par:abstract kills coqtop.
+- #5043: [Admitted] lemmas pick up section variables.
+- Fix name of internal refine ("simple refine").
+- #5062: probably a typo in Strict Proofs mode.
+- #5065: Anomaly: Not a proof by induction.
+- Restore native compiler optimizations, they were disabled since 8.5!
+- #5077: failure on typing a fixpoint with evars in its type.
+- Fix recursive notation bug.
+- #5095: non relevant too strict test in let-in abstraction.
+- Ensuring that the evar name is preserved by "rename".
+- #4887: confusion between using and with in documentation of firstorder.
+- Bug in subst with let-ins.
+- #4762: eauto weaker than auto.
+- Remove if_then_else (was buggy). Use tryif instead.
+- #4970: confusion between special "{" and non special "{{" in notations.
+- #4529: primitive projections unfolding.
+- #4416: Incorrect "Error: Incorrect number of goals".
+- #4863: abstract in typeclass hint fails.
+- #5123: unshelve can impact typeclass resolution
+- Fix a collision about the meta-variable ".." in recursive notations.
+- Fix printing of info_auto.
+- #3209: Not_found due to an occur-check cycle.
+- #5097: status of evars refined by "clear" in ltac: closed wrt evars.
+- #5150: Missing dependency of the test-suite subsystems in prerequisite.
+- Fix a bug in error printing of unif constraints
+- #3941: Do not stop propagation of signals when Coq is busy.
+- #4822: Incorrect assertion in cbn.
+- #3479 parsing of "{" and "}" when a keyword starts with "{" or "}".
+- #5127: Memory corruption with the VM.
+- #5102: bullets parsing broken by calls to parse_entry.
+
+Various documentation improvements
+
+
 Changes from V8.5pl1 to V8.5pl2
 ===============================
 
-Bugfixes
+Critical bugfix
+- Checksums of .vo files dependencies were not correctly checked.
+- Unicode-to-ASCII translation was not injective, leading in a soundness bug in
+  the native compiler.
 
-- #4677: fix alpha-conversion in notations needing eta-expansion
+Other bugfixes
+
+- #4097: more efficient occur-check in presence of primitive projections
+- #4398: type_scope used consistently in "match goal".
+- #4450: eauto does not work with polymorphic lemmas
+- #4677: fix alpha-conversion in notations needing eta-expansion.
 - Fully preserve initial order of hypotheses in "Regular Subst Tactic" mode.
+- #4644: a regression in unification.
+- #4725: Function (Error: Conversion test raised an anomaly) and Program
+  (Error: Cannot infer this placeholder of type)
+- #4747: Problem building Coq 8.5pl1 with OCaml 4.03.0: Fatal warnings
+- #4752: CoqIDE crash on files not ended by ".v".
+- #4777: printing inefficiency with implicit arguments
+- #4818: "Admitted" fails due to undefined universe anomaly after calling
+  "destruct"
+- #4823: remote counter: avoid thread race on sockets
+- #4841: -verbose flag changed semantics in 8.5, is much harder to use
+- #4851: [nsatz] cannot handle duplicated hypotheses
+- #4858: Anomaly: Uncaught exception Failure("hd"). Please report. in variant
+  of nsatz
+- #4880: [nsatz_compute] generates invalid certificates if given redundant
+  hypotheses
+- #4881: synchronizing "Declare Implicit Tactic" with backtrack.
+- #4882: anomaly with Declare Implicit Tactic on hole of type with evars
+- Fix use of "Declare Implicit Tactic" in refine.
+  triggered by CoqIDE
+- #4069, #4718: congruence fails when universes are involved.
+
+Universes
+- Disallow silently dropping universe instances applied to variables
+  (forward compatible)
+- Allow explicit universe instances on notations, when they can apply
+  to the head reference of their expansion.
+
+Build infrastructure
+- New update on how to find camlp5 binary and library at configure time.
 
 Changes from V8.5 to V8.5pl1
 ============================
@@ -465,8 +681,8 @@ Tactics
 - When given a reference as argument, simpl, vm_compute and
   native_compute now strictly interpret it as the head of a pattern
   starting with this reference.
-- The "change p with c" tactic semantics changed, now type-checking 
-  "c" at each matching occurrence "t" of the pattern "p", and 
+- The "change p with c" tactic semantics changed, now type-checking
+  "c" at each matching occurrence "t" of the pattern "p", and
   converting "t" with "c".
 - Now "appcontext" and "context" behave the same. The old buggy behavior of
   "context" can be retrieved at parse time by setting the
@@ -519,6 +735,9 @@ Tactics
 - Behavior of introduction patterns -> and <- made more uniform
   (hypothesis is cleared, rewrite in hypotheses and conclusion and
   erasing the variable when rewriting a variable).
+- New experimental option "Set Standard Proposition Elimination Names"
+  so that case analysis or induction on schemes in Type containing
+  propositions now produces "H"-based names.
 - Tactics from plugins are now active only when the corresponding module
   is imported (source of incompatibilities, solvable by adding an "Import";
   in the particular case of Omega, use "Require Import OmegaTactic").
@@ -930,7 +1149,7 @@ Extraction
   instead of accessing their body, they are now considered as axioms.
   The previous behaviour can be reactivated via the option
   "Set Extraction AccessOpaque".
-- The pretty-printer for Haskell now produces layout-independant code
+- The pretty-printer for Haskell now produces layout-independent code
 - A new command "Separate Extraction cst1 cst2 ..." that mixes a
   minimal extracted environment a la "Recursive Extraction" and the
   production of several files (one per coq source) a la "Extraction Library"
@@ -1057,9 +1276,6 @@ Other tactics
   clears (resp. reverts) H and all the hypotheses that depend on H.
 - Ltac's pattern-matching now supports matching metavariables that
   depend on variables bound upwards in the pattern.
-- New experimental option "Set Standard Proposition Elimination Names"
-  so that case analysis or induction on schemes in Type containing
-  propositions now produces "H"-based names.
 
 Tactic definitions
 
@@ -1618,7 +1834,7 @@ Tactics
   Moreover, romega now has a variant "romega with *" that can be also used
   on non-Z goals (nat, N, positive) via a call to a translation tactic named
   zify (its purpose is to Z-ify your goal...). This zify may also be used
-  independantly of romega.
+  independently of romega.
 - Tactic "remember" now supports an "in" clause to remember only selected
   occurrences of a term.
 - Tactic "pose proof" supports name overwriting in case of specialization of an
diff --git a/COMPATIBILITY b/COMPATIBILITY
index 883b8576d..d423e71df 100644
--- a/COMPATIBILITY
+++ b/COMPATIBILITY
@@ -1,3 +1,23 @@
+Potential sources of incompatibilities between Coq V8.5 and V8.6
+----------------------------------------------------------------
+
+Symptom: An obligation generated by Program or an abstracted subproof
+has different arguments.
+Cause: Set Shrink Abstract and Set Shrink Obligations are on by default
+and the subproof does not use the argument.
+Remedy:
+- Adapt the script.
+- Write an explicit lemma to prove the obligation/subproof and use it
+  instead (compatible with 8.4).
+- Unset the option for the program/proof the obligation/subproof originates
+  from.
+
+Symptom: In a goal, order of hypotheses, or absence of an equality of
+the form "x = t" or "t = x", or no unfolding of a local definition.
+Cause: This might be connected to a number of fixes in the tactic
+"subst". The former behavior can be reactivated by issuing "Unset
+Regular Subst Tactic".
+  
 Potential sources of incompatibilities between Coq V8.4 and V8.5
 ----------------------------------------------------------------
 
diff --git a/COPYRIGHT b/COPYRIGHT
index 006ce18f1..fc4b7baa4 100644
--- a/COPYRIGHT
+++ b/COPYRIGHT
@@ -1,6 +1,6 @@
                      The Coq proof assistant
 
-Copyright 1999-2015 The Coq development team, INRIA, CNRS, University
+Copyright 1999-2016 The Coq development team, INRIA, CNRS, University
 Paris Sud, University Paris 7, Ecole Polytechnique.
 
 This product includes also software developed by
@@ -9,6 +9,7 @@ This product includes also software developed by
   Claudio Sacerdoti Coen, HELM, University of Bologna, (plugins/xml)
   Pierre Corbineau, Radboud University, Nijmegen (declarative mode)
   John Harrison, University of Cambridge (csdp wrapper)
+  Georges Gonthier, Microsoft Research - Inria Joint Centre (plugins/ssrmatching)
 
 The file CREDITS contains a list of contributors.
 The credits section in the Reference Manual details contributions.
diff --git a/CREDITS b/CREDITS
index ace4648dc..c6848648e 100644
--- a/CREDITS
+++ b/CREDITS
@@ -54,6 +54,9 @@ plugins/setoid_ring
   developed by Benjamin Grégoire (INRIA-Everest, 2005-2006),
   Assia Mahboubi, Laurent Théry (INRIA-Marelle, 2006)
   and Bruno Barras (INRIA LogiCal, 2005-2006),
+plugins/ssrmatching
+  developed by Georges Gonthier (Microsoft Research - Inria Joint Centre, 2007-2011),
+  and Enrico Tassi (Inria-Marelle, 2011-now)
 plugins/subtac
   developed by Matthieu Sozeau (LRI, 2005-2008)
 plugins/micromega
diff --git a/INSTALL b/INSTALL
index 5a300010d..9454bba4a 100644
--- a/INSTALL
+++ b/INSTALL
@@ -1,5 +1,5 @@
 
-            INSTALLATION PROCEDURES FOR THE COQ V8.5 SYSTEM
+            INSTALLATION PROCEDURES FOR THE COQ V8.6 SYSTEM
             -----------------------------------------------
 
 
@@ -27,19 +27,20 @@ WHAT DO YOU NEED ?
 
      port install coq
 
-   To compile Coq V8.5 yourself, you need:
+   To compile Coq V8.6 yourself, you need:
 
-   - Objective Caml version 4.01.0 or later
+   - OCaml version 4.02.1 or later
      (available at http://caml.inria.fr/)
 
+     OCaml version 4.02.0 is not supported because of a severe performance
+     issue increasing compilation time.
+
    - Findlib (included in OCaml binary distribution under windows,
      probably available in your distribution and for sure at
      http://projects.camlcity.org/projects/findlib.html)
 
    - Camlp5 (version >= 6.02) (Coq compiles with Camlp4 but might be
-     less well supported, for instance, Objective Caml version 4.02.1
-     is then needed or a patched version of 4.01.0 as e.g. version
-     4.01.0-4 in Debian Jessie)
+     less well supported)
 
    - GNU Make version 3.81 or later
 
@@ -65,8 +66,8 @@ INSTALLATION PROCEDURE IN DETAILS (NORMAL USERS).
    computer and that "ocamlc" (or, better, its native code version
    "ocamlc.opt") lies in a directory which is present in your $PATH
    environment variable. At the time of writing this sentence, all
-   versions of Objective Caml later or equal to 4.01.0 are
-   supported to the exception of Objective Caml 4.02.0.
+   versions of Objective Caml later or equal to 4.02.1 are
+   supported.
 
    To get Coq in native-code, (it runs 4 to 10 times faster than
    bytecode, but it takes more time to get compiled and the binary is
diff --git a/INSTALL.ide b/INSTALL.ide
index cb7ca325f..513e37c91 100644
--- a/INSTALL.ide
+++ b/INSTALL.ide
@@ -22,7 +22,7 @@ Else, read the rest of this document to compile your own CoqIde.
 
 COMPILATION REQUIREMENTS
 
-- OCaml >= 4.01 with native threads support.
+- OCaml >= 4.02.1 with native threads support.
 - make world must succeed.
 - The graphical toolkit GTK+ 2.x. See http://www.gtk.org.
   The official supported version is at least 2.24.x.
diff --git a/META.coq b/META.coq
new file mode 100644
index 000000000..5be69d5fd
--- /dev/null
+++ b/META.coq
@@ -0,0 +1,249 @@
+description = "The Coq Proof Assistant Plugin API"
+version = "8.6"
+
+directory = ""
+requires = "camlp5"
+
+package "config" (
+
+  description = "Coq Configuration Variables"
+  version     = "8.6"
+
+  directory   = "config"
+
+)
+
+package "lib" (
+
+  description = "Base Coq Library"
+  version     = "8.6"
+
+  directory   = "lib"
+
+  requires         = "coq.config"
+
+  archive(byte)    = "clib.cma"
+  archive(byte)   += "lib.cma"
+
+  archive(native)  = "clib.cmxa"
+  archive(native) += "lib.cmxa"
+
+)
+
+package "vm" (
+
+  description = "Coq VM"
+
+  version     = "8.6"
+
+# EJGA FIXME: Unfortunately dllpath is dependent on the type of Coq
+# install. In a local one we'll want kernel/byterun, in a non-local
+# one we want to set it to coqlib. We should thus generate this file
+# at configure time, but let's hear for some more feedback from
+# experts.
+
+# Enable for local native & byte builds
+#  directory        = "kernel/byterun"
+
+# Enable for local byte builds and set up properly
+#  linkopts(byte)   = "-dllpath /path/to/coq/kernel/byterun/ -dllib -lcoqrun"
+
+# Disable for local byte builds
+  linkopts(byte)   = "-dllib -lcoqrun"
+  linkopts(native) = "-cclib -lcoqrun"
+
+)
+
+package "kernel" (
+
+  description = "The Coq's Kernel"
+  version     = "8.6"
+
+  directory   = "kernel"
+
+  requires    = "coq.lib, coq.vm"
+
+  archive(byte)    = "kernel.cma"
+  archive(native)  = "kernel.cmxa"
+
+)
+
+package "library" (
+
+  description = "Coq Libraries (vo) support"
+  version     = "8.6"
+
+  requires    = "coq.kernel"
+
+  directory   = "library"
+
+  archive(byte)    = "library.cma"
+  archive(native)  = "library.cmxa"
+
+)
+
+package "intf" (
+
+  description = "Coq Public Data Types"
+  version     = "8.6"
+
+  requires    = "coq.library"
+
+  directory   = "intf"
+
+)
+
+package "engine" (
+
+  description = "Coq Libraries (vo) support"
+  version     = "8.6"
+
+  requires    = "coq.library"
+  directory   = "engine"
+
+  archive(byte)    = "engine.cma"
+  archive(native)  = "engine.cmxa"
+
+)
+
+package "pretyping" (
+
+  description = "Coq Pretyper"
+  version     = "8.6"
+
+  requires    = "coq.engine"
+  directory   = "pretyping"
+
+  archive(byte)    = "pretyping.cma"
+  archive(native)  = "pretyping.cmxa"
+
+)
+
+package "interp" (
+
+  description = "Coq Term Interpretation"
+  version     = "8.6"
+
+  requires    = "coq.pretyping"
+  directory   = "interp"
+
+  archive(byte)    = "interp.cma"
+  archive(native)  = "interp.cmxa"
+
+)
+
+package "grammar" (
+
+  description = "Coq Base Grammar"
+  version     = "8.6"
+
+  requires    = "coq.interp"
+  directory   = "grammar"
+
+  archive(byte)   = "grammar.cma"
+  archive(native) = "grammar.cmxa"
+)
+
+package "proofs" (
+
+  description = "Coq Proof Engine"
+  version     = "8.6"
+
+  requires    = "coq.interp"
+  directory   = "proofs"
+
+  archive(byte)    = "proofs.cma"
+  archive(native)  = "proofs.cmxa"
+
+)
+
+package "parsing" (
+
+  description = "Coq Parsing Engine"
+  version     = "8.6"
+
+  requires    = "coq.proofs"
+  directory   = "parsing"
+
+  archive(byte)    = "parsing.cma"
+  archive(native)  = "parsing.cmxa"
+
+)
+
+package "printing" (
+
+  description = "Coq Printing Libraries"
+  version     = "8.6"
+
+  requires    = "coq.parsing"
+  directory   = "printing"
+
+  archive(byte)    = "printing.cma"
+  archive(native)  = "printing.cmxa"
+
+)
+
+package "tactics" (
+
+  description = "Coq Tactics"
+  version     = "8.6"
+
+  requires    = "coq.printing"
+  directory   = "tactics"
+
+  archive(byte)    = "tactics.cma"
+  archive(native)  = "tactics.cmxa"
+
+)
+
+package "stm" (
+
+  description = "Coq State Transactional Machine"
+  version     = "8.6"
+
+  requires    = "coq.tactics"
+  directory   = "stm"
+
+  archive(byte)    = "stm.cma"
+  archive(native)  = "stm.cmxa"
+
+)
+
+package "toplevel" (
+
+  description = "Coq Toplevel"
+  version     = "8.6"
+
+  requires    = "coq.stm"
+  directory   = "toplevel"
+
+  archive(byte)    = "toplevel.cma"
+  archive(native)  = "toplevel.cmxa"
+
+)
+
+package "highparsing" (
+
+  description = "Coq Extra Parsing"
+  version     = "8.6"
+
+  requires    = "coq.toplevel"
+  directory   = "parsing"
+
+  archive(byte)    = "highparsing.cma"
+  archive(native)  = "highparsing.cmxa"
+
+)
+
+package "ltac" (
+
+  description = "Coq LTAC Plugin"
+  version     = "8.6"
+
+  requires    = "coq.highparsing"
+  directory   = "ltac"
+
+  archive(byte)    = "ltac.cma"
+  archive(native)  = "ltac.cmxa"
+
+)
diff --git a/Makefile b/Makefile
index 17ff8041f..e1d6e8e1d 100644
--- a/Makefile
+++ b/Makefile
@@ -59,6 +59,10 @@ define find
  $(shell find . $(FIND_VCS_CLAUSE) '(' -name $(1) ')' -print | sed 's|^\./||')
 endef
 
+define findindir
+ $(shell find $(1) $(FIND_VCS_CLAUSE) '(' -name $(2) ')' -print | sed 's|^\./||')
+endef
+
 define findx
  $(shell find . $(FIND_VCS_CLAUSE) '(' -name $(1) ')' -exec $(2) {} \; | sed 's|^\./||')
 endef
@@ -66,9 +70,9 @@ endef
 ## Files in the source tree
 
 LEXFILES := $(call find, '*.mll')
-export MLLIBFILES := $(call find, '*.mllib')
+export MLLIBFILES := $(call find, '*.mllib') $(call find, '*.mlpack')
 export ML4FILES := $(call find, '*.ml4')
-export CFILES := $(call find, '*.c')
+export CFILES := $(call findindir, 'kernel/byterun', '*.c')
 
 # NB: The lists of currently existing .ml and .mli files will change
 # before and after a build or a make clean. Hence we do not export
@@ -80,9 +84,7 @@ EXISTINGMLI := $(call find, '*.mli')
 ## Files that will be generated
 
 GENML4FILES:= $(ML4FILES:.ml4=.ml)
-GENPLUGINSMOD:=$(filter plugins/%,$(MLLIBFILES:%.mllib=%_mod.ml))
-export GENMLFILES:=$(LEXFILES:.mll=.ml) $(GENPLUGINSMOD) \
-  tools/tolink.ml kernel/copcodes.ml
+export GENMLFILES:=$(LEXFILES:.mll=.ml) tools/tolink.ml kernel/copcodes.ml
 export GENHFILES:=kernel/byterun/coq_jumptbl.h
 export GENVFILES:=theories/Numbers/Natural/BigN/NMake_gen.v
 export GENFILES:=$(GENMLFILES) $(GENMLIFILES) $(GENHFILES) $(GENVFILES)
@@ -119,6 +121,8 @@ help:
 	@echo "or make archclean"
 	@echo
 	@echo "For make to be verbose, add VERBOSE=1"
+	@echo
+	@echo "If you want camlp{4,5} to generate human-readable files, add READABLE_ML4=1"
 
 UNSAVED_FILES:=$(shell find . -name '.\#*v' -o -name '.\#*.ml' -o -name '.\#*.ml?')
 ifdef UNSAVED_FILES
@@ -153,13 +157,13 @@ noconfig:
 
 # To speed-up things a bit, let's dissuade make to attempt rebuilding makefiles
 
-Makefile Makefile.build Makefile.common config/Makefile : ;
+Makefile $(wildcard Makefile.*) config/Makefile : ;
 
 ###########################################################################
 # Cleaning
 ###########################################################################
 
-.PHONY: clean cleankeepvo objclean cruftclean indepclean docclean archclean optclean clean-ide ml4clean ml4depclean depclean cleanconfig distclean voclean devdocclean
+.PHONY: clean cleankeepvo objclean cruftclean indepclean docclean archclean optclean clean-ide ml4clean depclean cleanconfig distclean voclean devdocclean
 
 clean: objclean cruftclean depclean docclean devdocclean
 
@@ -173,7 +177,7 @@ cruftclean: ml4clean
 
 indepclean:
 	rm -f $(GENFILES)
-	rm -f $(COQTOPBYTE) $(CHICKENBYTE) $(FAKEIDE)
+	rm -f $(COQTOPBYTE) $(CHICKENBYTE)
 	find . \( -name '*~' -o -name '*.cm[ioat]' -o -name '*.cmti' \) -delete
 	rm -f */*.pp[iox] plugins/*/*.pp[iox]
 	rm -rf $(SOURCEDOCDIR)
@@ -206,8 +210,8 @@ archclean: clean-ide optclean voclean
 	rm -f $(ALLSTDLIB).*
 
 optclean:
-	rm -f $(COQTOPEXE) $(COQMKTOP) $(COQC) $(CHICKEN) $(COQDEPBOOT)
-	rm -f $(TOOLS) $(CSDPCERT)
+	rm -f $(COQTOPEXE) $(COQMKTOP) $(CHICKEN)
+	rm -f $(TOOLS) $(PRIVATEBINARIES) $(CSDPCERT)
 	find . -name '*.cmx' -o -name '*.cmxs' -o -name '*.cmxa' -o -name '*.[soa]' -o -name '*.so' | xargs rm -f
 
 clean-ide:
@@ -220,9 +224,6 @@ clean-ide:
 ml4clean:
 	rm -f $(GENML4FILES)
 
-ml4depclean:
-	find . -name '*.ml4.d' | xargs rm -f
-
 depclean:
 	find . $(FIND_VCS_CLAUSE) '(' -name '*.d' ')' -print | xargs rm -f
 
@@ -230,12 +231,13 @@ cacheclean:
 	find theories plugins test-suite -name '.*.aux' -delete
 
 cleanconfig:
-	rm -f config/Makefile config/coq_config.ml myocamlbuild_config.ml dev/ocamldebug-v7 config/Info-*.plist
+	rm -f config/Makefile config/coq_config.ml myocamlbuild_config.ml dev/ocamldebug-coq dev/camlp4.dbg config/Info-*.plist
 
 distclean: clean cleanconfig cacheclean
 
 voclean:
 	find theories plugins test-suite \( -name '*.vo' -o -name '*.glob' -o -name "*.cmxs" -o -name "*.native" -o -name "*.cmx" -o -name "*.cmi" -o -name "*.o" \) -delete
+	find theories plugins test-suite -name .coq-native -empty -delete
 
 devdocclean:
 	find . -name '*.dep.ps' -o -name '*.dot' | xargs rm -f
@@ -244,6 +246,11 @@ devdocclean:
 	rm -f $(OCAMLDOCDIR)/html/*.html
 
 ###########################################################################
+# Continuous Intregration Tests
+###########################################################################
+include Makefile.ci
+
+###########################################################################
 # Emacs tags
 ###########################################################################
 
diff --git a/Makefile.build b/Makefile.build
index 10926daa1..9d76638e1 100644
--- a/Makefile.build
+++ b/Makefile.build
@@ -10,30 +10,74 @@
 # some variables.
 
 ###########################################################################
-# Starting rule
+# User-customizable variables
 ###########################################################################
 
-# build the different subsystems: coq, coqide
-world: revision coq coqide documentation
+# The following variables could be modified via the command-line of make,
+# either with the syntax 'make XYZ=1' or 'XYZ=1 make'
 
-.PHONY: world
+# To see the actual commands launched by make instead of shortened versions,
+# set this variable to 1 (or any non-empty value):
+VERBOSE ?=
+
+# If set to 1 (or non-empty) then *.ml files corresponding to *.ml4 files
+# will be generated in a human-readable format rather than in a binary format.
+READABLE_ML4 ?=
+
+# When non-empty, a time command is performed at each .v compilation.
+# To collect compilation timings of .v and import them in a spreadsheet,
+# you could hence consider: make TIMED=1 2> timings.csv
+TIMED ?=
+
+# When $(TIMED) is set, the time command used by default is $(STDTIME)
+# (see below), unless the following variable is non-empty. For instance,
+# it could be set to "'/usr/bin/time -p'".
+TIMECMD ?=
+
+# Non-empty skips the update of all dependency .d files:
+NO_RECALC_DEPS ?=
+
+# Non-empty runs the checker on all produced .vo files:
+VALIDATE ?=
+
+# Is "-xml" when building XML library:
+COQ_XML ?=
 
 ###########################################################################
-# Includes
+# Default starting rule
 ###########################################################################
 
-include Makefile.common
-include Makefile.doc
+# build the different subsystems:
+
+world: coq coqide documentation revision
+
+coq: coqlib coqbinaries tools printers
+
+.PHONY: world coq
+
+###########################################################################
+# Includes
+###########################################################################
 
+# This list of ml files used to be in the main Makefile, we moved it here
+# to avoid exhausting the variable env in Win32
 MLFILES := $(MLSTATICFILES) $(GENMLFILES) $(ML4FILES:.ml4=.ml)
-DEPENDENCIES := \
- $(addsuffix .d, $(MLFILES) $(MLIFILES) $(MLLIBFILES) $(CFILES) $(VFILES))
 
-# This include below will lauch the build of all concerned .d.
+include Makefile.common
+include Makefile.doc      ## provides the 'documentation' rule
+include Makefile.checker
+include Makefile.ide      ## provides the 'coqide' rule
+include Makefile.install
+include Makefile.dev      ## provides the 'printers' and 'revision' rules
+
+# This include below will lauch the build of all .d.
 # The - at front is for disabling warnings about currently missing ones.
 # For creating the missing .d, make will recursively build things like
 # coqdep_boot (for the .v.d files) or grammar.cma (for .ml4 -> .ml -> .ml.d).
 
+DEPENDENCIES := \
+ $(addsuffix .d, $(MLFILES) $(MLIFILES) $(MLLIBFILES) $(CFILES) $(VFILES))
+
 -include $(DEPENDENCIES)
 
 # All dependency includes must be declared secondary, otherwise make will
@@ -43,48 +87,22 @@ DEPENDENCIES := \
 
 .SECONDARY: $(DEPENDENCIES) $(GENFILES) $(ML4FILES:.ml4=.ml)
 
-
 ###########################################################################
 # Compilation options
 ###########################################################################
 
-# Variables meant to be modifiable via the command-line of make
-
-VERBOSE=
-NO_RECOMPILE_ML4=
-NO_RECALC_DEPS=
-READABLE_ML4=	# non-empty means .ml of .ml4 will be ascii instead of binary
-VALIDATE=
-COQ_XML=	# is "-xml" when building XML library
-VM=		# is "-no-vm" to not use the vm"
-
-TIMED=          # non-empty will activate a default time command
-                # when compiling .v (see $(STDTIME) below)
-
-TIMECMD=	# if you prefer a specific time command instead of $(STDTIME)
-                # e.g. "'time -p'"
+# Default timing command
+STDTIME=/usr/bin/time -f "$* (user: %U mem: %M ko)"
 
-# NB: if you want to collect compilation timings of .v and import them
-# in a spreadsheet, I suggest something like:
-#   make TIMED=1 2> timings.csv
+TIMER=$(if $(TIMED), $(STDTIME), $(TIMECMD))
 
 # NB: do not use a variable named TIME, since this variable controls
 # the output format of the unix command time. For instance:
 #   TIME="%C (%U user, %S sys, %e total, %M maxres)"
 
-STDTIME=/usr/bin/time -f "$* (user: %U mem: %M ko)"
-TIMER=$(if $(TIMED), $(STDTIME), $(TIMECMD))
-
-COQOPTS=$(COQ_XML) $(VM) $(NATIVECOMPUTE)
+COQOPTS=$(COQ_XML) $(NATIVECOMPUTE)
 BOOTCOQC=$(TIMER) $(COQTOPEXE) -boot $(COQOPTS) -compile
 
-# The SHOW and HIDE variables control whether make will echo complete commands 
-# or only abbreviated versions. 
-# Quiet mode is ON by default except if VERBOSE=1 option is given to make
-
-SHOW := $(if $(VERBOSE),@true "",@echo "")
-HIDE := $(if $(VERBOSE),,@)
-
 LOCALINCLUDES=$(addprefix -I , $(SRCDIRS) )
 MLINCLUDES=$(LOCALINCLUDES) -I $(MYCAMLP4LIB)
 
@@ -104,22 +122,40 @@ LINKMETADATA=
 CODESIGN=true
 endif
 
+# Best OCaml compiler, used in a generic way
+
+ifeq ($(BEST),opt)
+OPT:=opt
+BESTOBJ:=.cmx
+BESTLIB:=.cmxa
+BESTDYN:=.cmxs
+else
+OPT:=
+BESTOBJ:=.cmo
+BESTLIB:=.cma
+BESTDYN:=.cma
+endif
+
+define bestobj
+$(patsubst %.cma,%$(BESTLIB),$(patsubst %.cmo,%$(BESTOBJ),$(1)))
+endef
+
 define bestocaml
 $(if $(OPT),\
 $(OCAMLOPT) $(MLINCLUDES) $(OPTFLAGS) $(LINKMETADATA) -o $@ $(1) $(addsuffix .cmxa,$(2)) $^ && $(STRIP) $@ && $(CODESIGN) $@,\
 $(OCAMLC) $(MLINCLUDES) $(BYTEFLAGS) $(CUSTOM) -o $@ $(1) $(addsuffix .cma,$(2)) $^)
 endef
 
-CAMLP4DEPS:=tools/compat5.cmo grammar/grammar.cma grammar/q_constr.cmo
+# Camlp4 / Camlp5 settings
+
+CAMLP4DEPS:=grammar/compat5.cmo grammar/grammar.cma
 ifeq ($(CAMLP4),camlp5)
 CAMLP4USE=pa_extend.cmo q_MLast.cmo pa_macro.cmo -D$(CAMLVERSION)
 else
 CAMLP4USE=-D$(CAMLVERSION)
 endif
 
-CAMLP4FLAGS=-I $(CAMLLIB) -I $(CAMLLIB)/threads -I $(MYCAMLP4LIB) unix.cma threads.cma
-
-PR_O := $(if $(READABLE_ML4),pr_o.cmo,pr_dump.cmo) # works also with new camlp4
+PR_O := $(if $(READABLE_ML4),pr_o.cmo,pr_dump.cmo)
 
 SYSMOD:=str unix dynlink threads
 SYSCMA:=$(addsuffix .cma,$(SYSMOD))
@@ -136,6 +172,13 @@ endif
 # Infrastructure for the rest of the Makefile
 ###########################################################################
 
+# The SHOW and HIDE variables control whether make will echo complete commands
+# or only abbreviated versions.
+# Quiet mode is ON by default except if VERBOSE=1 option is given to make
+
+SHOW := $(if $(VERBOSE),@true "",@echo "")
+HIDE := $(if $(VERBOSE),,@)
+
 define order-only-template
  ifeq "order-only" "$(1)"
    ORDER_ONLY_SEP:=|
@@ -156,13 +199,8 @@ ifdef VALIDATE
  VO_TOOLS_DEP += $(CHICKEN)
 endif
 
-ifdef NO_RECALC_DEPS
-  D_DEPEND_BEFORE_SRC:=|
-  D_DEPEND_AFTER_SRC:=
-else
-  D_DEPEND_BEFORE_SRC:=
-  D_DEPEND_AFTER_SRC:=|
-endif
+D_DEPEND_BEFORE_SRC := $(if $(NO_RECALC_DEPS),|,)
+D_DEPEND_AFTER_SRC := $(if $(NO_RECALC_DEPS),,|)
 
 ## When a rule redirects stdout of a command to the target file : cmd > $@
 ## then the target file will be created even if cmd has failed.
@@ -172,21 +210,18 @@ endif
 TOTARGET = > "$@" || (RV=$$?; rm -f "$@"; exit $${RV})
 
 ###########################################################################
-# Compilation option for .c files
+# Compilation of .c files
 ###########################################################################
 
 CINCLUDES= -I $(CAMLHLIB)
 
-# libcoqrun.a, dllcoqrun.so
-
 # NB: We used to do a ranlib after ocamlmklib, but it seems that
 # ocamlmklib is already doing it
 
 $(LIBCOQRUN): kernel/byterun/coq_jumptbl.h $(BYTERUN)
 	cd $(dir $(LIBCOQRUN)) && \
-	$(OCAMLFIND) ocamlmklib -oc $(COQRUN) $(foreach u,$(BYTERUN),$(notdir $(u)))
+	$(OCAMLFIND) ocamlmklib -oc $(COQRUN) $(notdir $(BYTERUN))
 
-#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' $< $(TOTARGET)
@@ -195,25 +230,54 @@ kernel/copcodes.ml: kernel/byterun/coq_instruct.h
 	sed -n -e '/^enum/p' -e 's/,//g' -e '/^  /p' $< | \
 	awk -f kernel/make-opcodes $(TOTARGET)
 
+%.o: %.c
+	$(SHOW)'OCAMLC    $<'
+	$(HIDE)cd $(dir $<) && $(OCAMLC) -ccopt "$(CFLAGS)" -c $(notdir $<)
+
+%_stubs.c.d: $(D_DEPEND_BEFORE_SRC) %_stubs.c $(D_DEPEND_AFTER_SRC)
+	$(SHOW)'CCDEP	$<'
+	$(HIDE)echo "$@ $(@:.c.d=.o): $(@:.c.d=.c)" > $@
+
+%.c.d: $(D_DEPEND_BEFORE_SRC) %.c $(D_DEPEND_AFTER_SRC) $(GENHFILES)
+	$(SHOW)'CCDEP     $<'
+	$(HIDE)$(OCAMLC) -ccopt "-MM -MQ $@ -MQ $(<:.c=.o) -isystem $(CAMLHLIB)" $< $(TOTARGET)
+
+###########################################################################
+### Special rules (Camlp5 / Camlp4)
+###########################################################################
+
+# Special rule for the compatibility-with-camlp5 extension for camlp4
+#
+# - grammar/compat5.cmo changes 'GEXTEND' into 'EXTEND'. Safe, always loaded
+# - grammar/compat5b.cmo changes 'EXTEND' into 'EXTEND Gram'. Interact badly with
+#    syntax such that 'VERNAC EXTEND', we only load it in grammar/
+
+ifeq ($(CAMLP4),camlp4)
+grammar/compat5.cmo: grammar/compat5.mlp
+	$(OCAMLC) -c -I $(MYCAMLP4LIB) -pp '$(CAMLP4O) -I $(MYCAMLP4LIB) -impl' -impl $<
+grammar/compat5b.cmo: grammar/compat5b.mlp
+	$(OCAMLC) -c -I $(MYCAMLP4LIB) -pp '$(CAMLP4O) -I $(MYCAMLP4LIB) -impl' -impl $<
+else
+grammar/compat5.cmo: grammar/compat5.ml
+	$(OCAMLC) -c $<
+endif
 
 ###########################################################################
 #  grammar/grammar.cma
 ###########################################################################
 
-## In this part, we compile grammar/grammar.cma (and grammar/q_constr.cmo)
+## In this part, we compile grammar/grammar.cma
 ## without relying on .d dependency files, for bootstraping the creation
 ## and inclusion of these .d files
 
 ## Explicit dependencies for grammar stuff
 
 GRAMBASEDEPS := grammar/gramCompat.cmo grammar/q_util.cmi
-GRAMCMO := \
- grammar/gramCompat.cmo grammar/q_util.cmo \
+GRAMCMO := grammar/gramCompat.cmo grammar/q_util.cmo \
  grammar/argextend.cmo grammar/tacextend.cmo grammar/vernacextend.cmo
 
 grammar/q_util.cmi : grammar/gramCompat.cmo
 grammar/argextend.cmo : $(GRAMBASEDEPS)
-grammar/q_constr.cmo : $(GRAMBASEDEPS)
 grammar/q_util.cmo : $(GRAMBASEDEPS)
 grammar/tacextend.cmo : $(GRAMBASEDEPS) grammar/argextend.cmo
 grammar/vernacextend.cmo : $(GRAMBASEDEPS) grammar/tacextend.cmo \
@@ -228,22 +292,16 @@ GRAMC := $(OCAMLFIND) ocamlc $(CAMLFLAGS) $(CAMLDEBUG) $(USERFLAGS) \
 
 grammar/grammar.cma : $(GRAMCMO)
 	$(SHOW)'Testing $@'
-	@touch test.mlp
-	$(HIDE)$(CAMLP4O) -I $(MYCAMLP4LIB) $^ -impl test.mlp -o test.ml
-	$(HIDE)$(GRAMC) test.ml -o test-grammar
-	@rm -f test-grammar test.*
+	@touch grammar/test.mlp
+	$(HIDE)$(GRAMC) -pp '$(CAMLP4O) -I $(MYCAMLP4LIB) $^ -impl' -impl grammar/test.mlp -o grammar/test
+	@rm -f grammar/test.* grammar/test
 	$(SHOW)'OCAMLC -a $@'   
 	$(HIDE)$(GRAMC) $^ -linkall -a -o $@
 
 ## Support of Camlp5 and Camlp5
 
-# NB: compatibility modules for camlp4:
-# - tools/compat5.cmo changes GEXTEND into EXTEND. Safe, always loaded
-# - tools/compat5b.cmo changes EXTEND into EXTEND Gram. Interact badly with
-#    syntax such that VERNAC EXTEND, we only load it in grammar/
-
 ifeq ($(CAMLP4),camlp4)
- COMPATCMO:=tools/compat5.cmo tools/compat5b.cmo
+ COMPATCMO:=grammar/compat5.cmo grammar/compat5b.cmo
  GRAMP4USE:=$(COMPATCMO) -D$(CAMLVERSION)
  GRAMPP:=$(CAMLP4O) -I $(MYCAMLP4LIB) $(GRAMP4USE) $(CAMLP4COMPAT) -impl
 else
@@ -267,25 +325,16 @@ grammar/%.cmi: grammar/%.mli
 # Main targets (coqmktop, coqtop.opt, coqtop.byte)
 ###########################################################################
 
-.PHONY: coqbinaries coq coqlib coqlight states
-
-coqbinaries: ${COQBINARIES} ${CSDPCERT} ${FAKEIDE}
-
-coq: coqlib tools coqbinaries
-
-coqlib: theories plugins
-
-coqlight: theories-light tools coqbinaries
+.PHONY: coqbinaries
 
-states: theories/Init/Prelude.vo
+coqbinaries: $(COQMKTOP) $(COQTOPEXE) $(COQTOPBYTE) \
+ $(CHICKEN) $(CHICKENBYTE) $(CSDPCERT) $(FAKEIDE)
 
-miniopt: $(COQTOPEXE) pluginsopt
-minibyte: $(COQTOPBYTE) pluginsbyte
 
 ifeq ($(BEST),opt)
 $(COQTOPEXE): $(COQMKTOP) $(LINKCMX) $(LIBCOQRUN) $(TOPLOOPCMA:.cma=.cmxs)
 	$(SHOW)'COQMKTOP -o $@'	
-	$(HIDE)$(COQMKTOP) -boot -opt $(OPTFLAGS) $(LINKMETADATA) -thread -o $@
+	$(HIDE)$(COQMKTOP) -boot -opt $(OPTFLAGS) $(LINKMETADATA) -o $@
 	$(STRIP) $@
 	$(CODESIGN) $@
 else
@@ -295,28 +344,13 @@ endif
 
 $(COQTOPBYTE): $(COQMKTOP) $(LINKCMO) $(LIBCOQRUN) $(TOPLOOPCMA)
 	$(SHOW)'COQMKTOP -o $@'	
-	$(HIDE)$(COQMKTOP) -boot -top $(BYTEFLAGS) -thread -o $@
-
-LOCALCHKLIBS:=$(addprefix -I , $(CHKSRCDIRS) )
-CHKLIBS:=$(LOCALCHKLIBS) -I $(MYCAMLP4LIB)
+	$(HIDE)$(COQMKTOP) -boot -top $(BYTEFLAGS) -o $@
 
-ifeq ($(BEST),opt)
-$(CHICKEN): checker/check.cmxa checker/main.ml
-	$(SHOW)'OCAMLOPT -o $@'
-	$(HIDE)$(OCAMLOPT) $(CHKLIBS) $(OPTFLAGS) $(LINKMETADATA) -thread -o $@ $(SYSCMXA) $^
-	$(STRIP) $@
-	$(CODESIGN) $@
-else
-$(CHICKEN): $(CHICKENBYTE)
-	cp $< $@
-endif
+# coqmktop
 
-$(CHICKENBYTE): checker/check.cma checker/main.ml
-	$(SHOW)'OCAMLC -o $@'
-	$(HIDE)$(OCAMLC) $(CHKLIBS) $(BYTEFLAGS) $(CUSTOM) -thread -o $@ $(SYSCMA) $^
+COQMKTOPCMO:=lib/clib.cma lib/cErrors.cmo tools/tolink.cmo tools/coqmktop.cmo
 
-# coqmktop
-$(COQMKTOP): $(patsubst %.cma,%$(BESTLIB),$(COQMKTOPCMO:.cmo=$(BESTOBJ)))
+$(COQMKTOP): $(call bestobj, $(COQMKTOPCMO))
 	$(SHOW)'OCAMLBEST -o $@'
 	$(HIDE)$(call bestocaml, $(OSDEPLIBS), $(SYSMOD))
 
@@ -327,720 +361,184 @@ tools/tolink.ml: Makefile.build Makefile.common
 	$(HIDE)echo "let core_objs = \""$(OBJSMOD)"\"" >> $@
 
 # coqc
-$(COQC):  $(patsubst %.cma,%$(BESTLIB),$(COQCCMO:.cmo=$(BESTOBJ)))
-	$(SHOW)'OCAMLBEST -o $@'
-	$(HIDE)$(call bestocaml, $(OSDEPLIBS), $(SYSMOD))
-
-# Target for libraries .cma and .cmxa
-
-# The dependency over the .mllib is somewhat artificial, since
-# ocamlc -a won't use this file, hence the $(filter-out ...) below.
-# But this ensures that the .cm(x)a is rebuilt when needed,
-# (especially when removing a module in the .mllib).
-# We used to have a "order-only" dependency over .mllib.d here,
-# but the -include mechanism should already ensure that we have
-# up-to-date dependencies.
-
-%.cma: %.mllib
-	$(SHOW)'OCAMLC -a -o $@'
-	$(HIDE)$(OCAMLC) $(MLINCLUDES) $(BYTEFLAGS) -a -o $@ $(filter-out %.mllib, $^)
-
-%.cmxa: %.mllib
-	$(SHOW)'OCAMLOPT -a -o $@'
-	$(HIDE)$(OCAMLOPT) $(MLINCLUDES) $(OPTFLAGS) -a -o $@ $(filter-out %.mllib, $^)
-
-# For the checker, different flags may be used
-
-checker/check.cma: checker/check.mllib | md5chk
-	$(SHOW)'OCAMLC -a -o $@'
-	$(HIDE)$(OCAMLC) $(CHKLIBS) $(BYTEFLAGS) -a -o $@ $(filter-out %.mllib, $^)
-
-checker/check.cmxa: checker/check.mllib | md5chk
-	$(SHOW)'OCAMLOPT -a -o $@'
-	$(HIDE)$(OCAMLOPT) $(CHKLIBS) $(OPTFLAGS) -a -o $@ $(filter-out %.mllib, $^)
 
-###########################################################################
-# Csdp to micromega special targets
-###########################################################################
+COQCCMO:=lib/clib.cma lib/cErrors.cmo toplevel/usage.cmo tools/coqc.cmo
 
-plugins/micromega/csdpcert$(EXE): $(CSDPCERTCMO:.cmo=$(BESTOBJ))  \
-		$(addsuffix $(BESTLIB), lib/clib)
+$(COQC): $(call bestobj, $(COQCCMO))
 	$(SHOW)'OCAMLBEST -o $@'
-	$(HIDE)$(call bestocaml,,nums unix clib)
-
-###########################################################################
-# CoqIde special targets
-###########################################################################
-
-.PHONY: coqide coqide-binaries coqide-no coqide-byte coqide-opt coqide-files
-
-# target to build CoqIde
-coqide: coqide-files coqide-binaries theories/Init/Prelude.vo
-
-COQIDEFLAGS=$(addprefix -I , $(IDESRCDIRS)) $(COQIDEINCLUDES)
-
-.SUFFIXES:.vo
-
-IDEFILES=$(wildcard ide/*.lang) ide/coq_style.xml ide/coq.png ide/MacOS/default_accel_map
-
-coqide-binaries: coqide-$(HASCOQIDE) ide-toploop
-coqide-no:
-coqide-byte: $(COQIDEBYTE) $(COQIDE)
-coqide-opt:  $(COQIDEBYTE) $(COQIDE)
-coqide-files: $(IDEFILES)
-ifeq ($(BEST),opt)
-ide-toploop: $(IDETOPLOOPCMA) $(IDETOPLOOPCMA:.cma=.cmxs)
-else
-ide-toploop: $(IDETOPLOOPCMA)
-endif
-
-ifeq ($(HASCOQIDE),opt)
-$(COQIDE): $(LINKIDEOPT)
-	$(SHOW)'OCAMLOPT -o $@'
-	$(HIDE)$(OCAMLOPT) $(COQIDEFLAGS) $(OPTFLAGS) -o $@ unix.cmxa threads.cmxa lablgtk.cmxa \
-		lablgtksourceview2.cmxa str.cmxa $(IDEFLAGS:.cma=.cmxa) $^
-	$(STRIP) $@
-else
-$(COQIDE): $(COQIDEBYTE)
-	cp $< $@
-endif
-
-$(COQIDEBYTE): $(LINKIDE)
-	$(SHOW)'OCAMLC -o $@'
-	$(HIDE)$(OCAMLC) $(COQIDEFLAGS) $(BYTEFLAGS) -o $@ unix.cma threads.cma lablgtk.cma \
-	        lablgtksourceview2.cma str.cma $(IDEFLAGS) $(IDECDEPSFLAGS) $^
-
-# install targets
-
-.PHONY: install-coqide install-ide-bin install-ide-toploop install-ide-files install-ide-info install-ide-devfiles
-
-ifeq ($(HASCOQIDE),no)
-install-coqide: install-ide-toploop
-else
-install-coqide: install-ide-bin install-ide-toploop install-ide-files install-ide-info install-ide-devfiles
-endif
-
-install-ide-bin:
-	$(MKDIR) $(FULLBINDIR)
-	$(INSTALLBIN) $(COQIDE) $(FULLBINDIR)
-
-install-ide-toploop:
-	$(MKDIR) $(FULLCOQLIB)/toploop
-	$(INSTALLBIN) $(IDETOPLOOPCMA) $(FULLCOQLIB)/toploop/
-ifeq ($(BEST),opt)
-	$(INSTALLBIN) $(IDETOPLOOPCMA:.cma=.cmxs) $(FULLCOQLIB)/toploop/
-endif
-
-install-ide-devfiles:
-	$(MKDIR) $(FULLCOQLIB)
-	$(INSTALLSH) $(FULLCOQLIB) $(IDECMA) \
-	  $(foreach lib,$(IDECMA:.cma=_MLLIB_DEPENDENCIES),$(addsuffix .cmi,$($(lib))))
-ifeq ($(BEST),opt)
-	$(INSTALLSH) $(FULLCOQLIB) $(IDECMA:.cma=.cmxa) $(IDECMA:.cma=.a)
-endif
-
-install-ide-files: #Please update $(COQIDEAPP)/Contents/Resources/ at the same time
-	$(MKDIR) $(FULLDATADIR)
-	$(INSTALLLIB) ide/coq.png ide/*.lang ide/coq_style.xml $(FULLDATADIR)
-	$(MKDIR) $(FULLCONFIGDIR)
-	if [ $(IDEINT) = QUARTZ ] ; then $(INSTALLLIB) ide/mac_default_accel_map $(FULLCONFIGDIR)/coqide.keys ; fi
-
-install-ide-info:
-	$(MKDIR) $(FULLDOCDIR)
-	$(INSTALLLIB) ide/FAQ $(FULLDOCDIR)/FAQ-CoqIde
-
-###########################################################################
-# CoqIde MacOS special targets
-###########################################################################
-
-.PHONY: $(COQIDEAPP)/Contents
-
-$(COQIDEAPP)/Contents:
-	rm -rdf $@
-	$(MKDIR) $@
-	sed -e "s/VERSION/$(VERSION4MACOS)/g" ide/MacOS/Info.plist.template > $@/Info.plist
-	$(MKDIR) "$@/MacOS"
-
-$(COQIDEINAPP): ide/macos_prehook.cmx $(LINKIDEOPT) | $(COQIDEAPP)/Contents
-	$(SHOW)'OCAMLOPT -o $@'
-	$(HIDE)$(OCAMLOPT) $(COQIDEFLAGS) $(OPTFLAGS) -o $@ \
-		unix.cmxa lablgtk.cmxa lablgtksourceview2.cmxa str.cmxa \
-		threads.cmxa $(IDEFLAGS:.cma=.cmxa) $^
-	$(STRIP) $@
-
-$(COQIDEAPP)/Contents/Resources/share: $(COQIDEAPP)/Contents
-	$(MKDIR) $@/coq/
-	$(INSTALLLIB) ide/coq.png ide/*.lang ide/coq_style.xml $@/coq/
-	$(MKDIR) $@/gtksourceview-2.0/{language-specs,styles}
-	$(INSTALLLIB) "$(GTKSHARE)/"gtksourceview-2.0/language-specs/{def.lang,language2.rng} $@/gtksourceview-2.0/language-specs/
-	$(INSTALLLIB) "$(GTKSHARE)/"gtksourceview-2.0/styles/{styles.rng,classic.xml} $@/gtksourceview-2.0/styles/
-	cp -R "$(GTKSHARE)/"locale $@
-	cp -R "$(GTKSHARE)/"icons $@
-	cp -R "$(GTKSHARE)/"themes $@
-
-$(COQIDEAPP)/Contents/Resources/loaders: $(COQIDEAPP)/Contents
-	$(MKDIR) $@
-	$(INSTALLLIB) $$("$(GTKBIN)/gdk-pixbuf-query-loaders" | sed -n -e '5 s!.*= \(.*\)$$!\1!p')/libpixbufloader-png.so $@
-
-$(COQIDEAPP)/Contents/Resources/immodules: $(COQIDEAPP)/Contents
-	$(MKDIR) $@
-	$(INSTALLLIB) "$(GTKLIBS)/gtk-2.0/2.10.0/immodules/"*.so $@
-
-
-$(COQIDEAPP)/Contents/Resources/etc: $(COQIDEAPP)/Contents/Resources/lib
-	$(MKDIR) $@/xdg/coq
-	$(INSTALLLIB) ide/MacOS/default_accel_map $@/xdg/coq/coqide.keys
-	$(MKDIR) $@/gtk-2.0
-	{ "$(GTKBIN)/gdk-pixbuf-query-loaders" $@/../loaders/*.so |\
-	 sed -e "s!/.*\(/loaders/.*.so\)!@executable_path/../Resources/\1!"; } \
-	> $@/gtk-2.0/gdk-pixbuf.loaders
-	{ "$(GTKBIN)/gtk-query-immodules-2.0" $@/../immodules/*.so |\
-	 sed -e "s!/.*\(/immodules/.*.so\)!@executable_path/../Resources/\1!" |\
-	 sed -e "s!/.*\(/share/locale\)!@executable_path/../Resources/\1!"; } \
-	> $@/gtk-2.0/gtk-immodules.loaders
-	$(MKDIR) $@/pango
-	echo "[Pango]" > $@/pango/pangorc
-
-$(COQIDEAPP)/Contents/Resources/lib: $(COQIDEAPP)/Contents/Resources/immodules $(COQIDEAPP)/Contents/Resources/loaders $(COQIDEAPP)/Contents $(COQIDEINAPP)
-	$(MKDIR) $@
-	$(INSTALLLIB) $(GTKLIBS)/charset.alias $@/
-	$(MKDIR) $@/pango/1.8.0/modules
-	$(INSTALLLIB) "$(GTKLIBS)/pango/1.8.0/modules/"*.so $@/pango/1.8.0/modules/
-	{ "$(GTKBIN)/pango-querymodules" $@/pango/1.8.0/modules/*.so |\
-	 sed -e "s!/.*\(/pango/1.8.0/modules/.*.so\)!@executable_path/../Resources/lib\1!"; } \
-	> $@/pango/1.8.0/modules.cache
-
-	for i in $$(otool -L $(COQIDEINAPP) |sed -n -e "\@$(GTKLIBS)@ s/[^/]*\(\/[^ ]*\) .*$$/\1/p"); \
-	    do cp $$i $@/; \
-	    ide/MacOS/relatify_with-respect-to_.sh $@/$$(basename $$i) $(GTKLIBS) $@; \
-	done
-	for i in $@/../loaders/*.so $@/../immodules/*.so $@/pango/1.8.0/modules/*.so; \
-	    do \
-		for j in $$(otool -L $$i | sed -n -e "\@$(GTKLIBS)@ s/[^/]*\(\/[^ ]*\) .*$$/\1/p"); \
-		do cp $$j $@/; ide/MacOS/relatify_with-respect-to_.sh $@/$$(basename $$j) $(GTKLIBS) $@; done; \
-		ide/MacOS/relatify_with-respect-to_.sh $$i $(GTKLIBS) $@; \
-	    done
-	EXTRAWORK=1; \
-	while [ $${EXTRAWORK} -eq 1 ]; \
-	do EXTRAWORK=0; \
-	    for i in $@/*.dylib; \
-	    do for j in $$(otool -L $$i | sed -n -e "\@$(GTKLIBS)@ s/[^/]*\(\/[^ ]*\) .*$$/\1/p"); \
-		do EXTRAWORK=1; cp $$j $@/; ide/MacOS/relatify_with-respect-to_.sh $@/$$(basename $$j) $(GTKLIBS) $@; done; \
-	    done; \
-	done
-	ide/MacOS/relatify_with-respect-to_.sh $(COQIDEINAPP) $(GTKLIBS) $@
-
-$(COQIDEAPP)/Contents/Resources:$(COQIDEAPP)/Contents/Resources/etc $(COQIDEAPP)/Contents/Resources/share
-	$(INSTALLLIB) ide/MacOS/*.icns $@
-
-$(COQIDEAPP):$(COQIDEAPP)/Contents/Resources
-	$(CODESIGN) $@
-
-###########################################################################
-# tests
-###########################################################################
-
-.PHONY: validate check test-suite $(ALLSTDLIB).v md5chk
-
-md5chk:
-	$(SHOW)'MD5SUM cic.mli'
-	$(HIDE)if grep -q `$(MD5SUM) checker/cic.mli` checker/values.ml; \
-	       then true; else echo "Error: outdated checker/values.ml"; false; fi
-
-VALIDOPTS=$(if $(VERBOSE),,-silent) -o -m
-
-validate: $(CHICKEN) | $(ALLVO)
-	$(SHOW)'COQCHK <theories & plugins>'
-	$(HIDE)$(CHICKEN) -boot $(VALIDOPTS) $(ALLMODS)
-
-$(ALLSTDLIB).v:
-	$(SHOW)'MAKE $(notdir $@)'
-	$(HIDE)echo "Require $(ALLMODS)." > $@
-
-MAKE_TSOPTS=-C test-suite -s VERBOSE=$(VERBOSE)
-
-check: validate test-suite
-
-test-suite: world $(ALLSTDLIB).v
-	$(MAKE) $(MAKE_TSOPTS) clean
-	$(MAKE) $(MAKE_TSOPTS) all
-	$(MAKE) $(MAKE_TSOPTS) report
-
-##################################################################
-# partial targets: 1) core ML parts
-##################################################################
-
-.PHONY: lib kernel byterun library proofs tactics interp parsing pretyping
-.PHONY: engine highparsing stm toplevel ltac
-
-lib: lib/clib.cma lib/lib.cma
-kernel: kernel/kernel.cma
-byterun: $(BYTERUN)
-library: library/library.cma
-engine: engine/engine.cma
-proofs: proofs/proofs.cma
-tactics: tactics/tactics.cma
-interp: interp/interp.cma
-parsing: parsing/parsing.cma
-pretyping: pretyping/pretyping.cma
-highparsing: parsing/highparsing.cma
-stm: stm/stm.cma
-toplevel: toplevel/toplevel.cma
-ltac: ltac/ltac.cma
-
-###########################################################################
-# 2) theories and plugins files
-###########################################################################
-
-.PHONY: init theories theories-light
-.PHONY: logic arith bool narith zarith qarith lists strings sets
-.PHONY: fsets relations wellfounded reals setoids sorting numbers noreal
-.PHONY: msets mmaps compat
-
-init: $(INITVO)
-
-theories: $(THEORIESVO)
-theories-light: $(THEORIESLIGHTVO)
-
-logic: $(LOGICVO)
-arith: $(ARITHVO)
-bool: $(BOOLVO)
-narith: $(NARITHVO)
-zarith: $(ZARITHVO)
-qarith: $(QARITHVO)
-lists: $(LISTSVO)
-strings: $(STRINGSVO)
-sets: $(SETSVO)
-fsets: $(FSETSVO)
-relations: $(RELATIONSVO)
-wellfounded: $(WELLFOUNDEDVO)
-reals: $(REALSVO)
-setoids: $(SETOIDSVO)
-sorting: $(SORTINGVO)
-numbers: $(NUMBERSVO)
-unicode: $(UNICODEVO)
-classes: $(CLASSESVO)
-program: $(PROGRAMVO)
-structures: $(STRUCTURESVO)
-vectors: $(VECTORSVO)
-msets: $(MSETSVO)
-compat: $(COMPATVO)
-
-noreal: unicode logic arith bool zarith qarith lists sets fsets \
-	relations wellfounded setoids sorting
-
-###########################################################################
-# 3) plugins
-###########################################################################
-
-.PHONY: plugins omega micromega setoid_ring nsatz extraction
-.PHONY: fourier funind cc rtauto btauto pluginsopt pluginsbyte
-
-plugins: $(PLUGINSVO)
-omega: $(OMEGAVO) $(OMEGACMA) $(ROMEGAVO) $(ROMEGACMA)
-micromega: $(MICROMEGAVO) $(MICROMEGACMA) $(CSDPCERT)
-setoid_ring: $(RINGVO) $(RINGCMA)
-nsatz: $(NSATZVO) $(NSATZCMA)
-extraction: $(EXTRACTIONCMA)
-fourier: $(FOURIERVO) $(FOURIERCMA)
-funind: $(FUNINDCMA) $(FUNINDVO)
-cc: $(CCVO) $(CCCMA)
-rtauto: $(RTAUTOVO) $(RTAUTOCMA)
-btauto: $(BTAUTOVO) $(BTAUTOCMA)
-
-pluginsopt: $(PLUGINSOPT)
-pluginsbyte: $(PLUGINS)
-
-###########################################################################
-# rules to make theories and plugins
-###########################################################################
-
-theories/Init/%.vo theories/Init/%.glob: theories/Init/%.v $(VO_TOOLS_DEP)
-	$(SHOW)'COQC $(COQ_XML) -noinit $<'
-	$(HIDE)rm -f theories/Init/$*.glob
-	$(HIDE)$(BOOTCOQC) $< $(COQ_XML) -noinit -R theories Coq
-
-theories/Numbers/Natural/BigN/NMake_gen.v: theories/Numbers/Natural/BigN/NMake_gen.ml
-	$(OCAML) $< $(TOTARGET)
+	$(HIDE)$(call bestocaml, $(OSDEPLIBS), $(SYSMOD))
 
 ###########################################################################
-# tools
+# other tools
 ###########################################################################
 
-.PHONY: printers tools
-
-printers: $(DEBUGPRINTERS)
-
-tools: $(TOOLS) $(DEBUGPRINTERS) $(OCAMLLIBDEP)
+.PHONY: tools
+tools: $(TOOLS) $(OCAMLLIBDEP) $(COQDEPBOOT)
 
 # coqdep_boot : a basic version of coqdep, with almost no dependencies.
+# We state these dependencies here explicitly, since some .ml.d files
+# may still be missing or not taken in account yet by make when coqdep_boot
+# is being built.
 
-# Here it is important to mention .ml files instead of .cmo in order
-# to avoid using implicit rules : at the time coqdep_boot is being built,
-# some .ml.d files may still be missing or not taken in account yet by make.
+COQDEPBOOTSRC := lib/minisys.cmo \
+ tools/coqdep_lexer.cmo tools/coqdep_common.cmo tools/coqdep_boot.cmo
 
-COQDEPBOOTSRC := \
- lib/minisys.ml \
- tools/coqdep_lexer.mli tools/coqdep_lexer.ml \
- tools/coqdep_common.mli tools/coqdep_common.ml \
- tools/coqdep_boot.ml
+tools/coqdep_lexer.cmo : tools/coqdep_lexer.cmi
+tools/coqdep_lexer.cmx : tools/coqdep_lexer.cmi
+tools/coqdep_common.cmo : lib/minisys.cmo tools/coqdep_lexer.cmi tools/coqdep_common.cmi
+tools/coqdep_common.cmx : lib/minisys.cmx tools/coqdep_lexer.cmx tools/coqdep_common.cmi
+tools/coqdep_boot.cmo : tools/coqdep_common.cmi
+tools/coqdep_boot.cmx : tools/coqdep_common.cmx
 
-$(COQDEPBOOT): $(COQDEPBOOTSRC)
+$(COQDEPBOOT): $(call bestobj, $(COQDEPBOOTSRC))
 	$(SHOW)'OCAMLBEST -o $@'
 	$(HIDE)$(call bestocaml, -I tools, unix)
 
-# Same for ocamllibdep
-
-$(OCAMLLIBDEP): tools/ocamllibdep.ml
+$(OCAMLLIBDEP): $(call bestobj, tools/ocamllibdep.cmo)
 	$(SHOW)'OCAMLBEST -o $@'
 	$(HIDE)$(call bestocaml, -I tools, unix)
 
 # The full coqdep (unused by this build, but distributed by make install)
 
-$(COQDEP): $(patsubst %.cma,%$(BESTLIB),$(COQDEPCMO:.cmo=$(BESTOBJ)))
+COQDEPCMO:=lib/clib.cma lib/cErrors.cmo lib/cWarnings.cmo lib/minisys.cmo \
+  lib/system.cmo tools/coqdep_lexer.cmo tools/coqdep_common.cmo \
+  tools/coqdep.cmo
+
+$(COQDEP): $(call bestobj, $(COQDEPCMO))
 	$(SHOW)'OCAMLBEST -o $@'
 	$(HIDE)$(call bestocaml, $(OSDEPLIBS), $(SYSMOD))
 
-$(GALLINA): $(addsuffix $(BESTOBJ), tools/gallina_lexer tools/gallina)
+$(GALLINA): $(call bestobj, tools/gallina_lexer.cmo tools/gallina.cmo)
 	$(SHOW)'OCAMLBEST -o $@'
 	$(HIDE)$(call bestocaml,,)
 
-$(COQMAKEFILE):  $(patsubst %.cma,%$(BESTLIB),$(COQMAKEFILECMO:.cmo=$(BESTOBJ)))
+COQMAKEFILECMO:=lib/clib.cma ide/project_file.cmo tools/coq_makefile.cmo
+
+$(COQMAKEFILE): $(call bestobj,$(COQMAKEFILECMO))
 	$(SHOW)'OCAMLBEST -o $@'
 	$(HIDE)$(call bestocaml,,str unix threads)
 
-$(COQTEX): tools/coq_tex$(BESTOBJ)
+$(COQTEX): $(call bestobj, tools/coq_tex.cmo)
 	$(SHOW)'OCAMLBEST -o $@'
 	$(HIDE)$(call bestocaml,,str)
 
-$(COQWC): tools/coqwc$(BESTOBJ)
+$(COQWC): $(call bestobj, tools/coqwc.cmo)
 	$(SHOW)'OCAMLBEST -o $@'
 	$(HIDE)$(call bestocaml,,)
 
-$(COQDOC): $(patsubst %.cma,%$(BESTLIB),$(COQDOCCMO:.cmo=$(BESTOBJ)))
+COQDOCCMO:=lib/clib.cma $(addprefix tools/coqdoc/, \
+  cdglobals.cmo alpha.cmo index.cmo tokens.cmo output.cmo cpretty.cmo main.cmo )
+
+$(COQDOC): $(call bestobj, $(COQDOCCMO))
 	$(SHOW)'OCAMLBEST -o $@'
 	$(HIDE)$(call bestocaml,,str unix)
 
-$(COQWORKMGR): $(addsuffix $(BESTOBJ), stm/coqworkmgrApi tools/coqworkmgr) \
-		$(addsuffix $(BESTLIB), lib/clib)
+$(COQWORKMGR): $(call bestobj, lib/clib.cma stm/coqworkmgrApi.cmo tools/coqworkmgr.cmo)
 	$(SHOW)'OCAMLBEST -o $@'
-	$(HIDE)$(call bestocaml,, $(SYSMOD) clib)
+	$(HIDE)$(call bestocaml,, $(SYSMOD))
 
 # fake_ide : for debugging or test-suite purpose, a fake ide simulating
 # a connection to coqtop -ideslave
 
-$(FAKEIDE): lib/clib$(BESTLIB) lib/xml_lexer$(BESTOBJ) lib/xml_parser$(BESTOBJ) lib/xml_printer$(BESTOBJ) lib/errors$(BESTOBJ) lib/spawn$(BESTOBJ) ide/document$(BESTOBJ) ide/xmlprotocol$(BESTOBJ) tools/fake_ide$(BESTOBJ) | $(IDETOPLOOPCMA:.cma=$(BESTDYN))
+FAKEIDECMO:= lib/clib.cma lib/cErrors.cmo lib/spawn.cmo ide/document.cmo \
+ ide/serialize.cmo ide/xml_lexer.cmo ide/xml_parser.cmo ide/xml_printer.cmo \
+ ide/xmlprotocol.cmo tools/fake_ide.cmo
+
+$(FAKEIDE): $(call bestobj, $(FAKEIDECMO)) | $(IDETOPLOOPCMA:.cma=$(BESTDYN))
 	$(SHOW)'OCAMLBEST -o $@'
 	$(HIDE)$(call bestocaml,-I ide,str unix threads)
 
 # votour: a small vo explorer (based on the checker)
 
-bin/votour: lib/cObj$(BESTOBJ) checker/analyze$(BESTOBJ) checker/values$(BESTOBJ) checker/votour.ml
+bin/votour: $(call bestobj, lib/cObj.cmo checker/analyze.cmo checker/values.cmo checker/votour.cmo)
 	$(SHOW)'OCAMLBEST -o $@'
 	$(HIDE)$(call bestocaml, -I checker,)
 
-# Special rule for the compatibility-with-camlp5 extension for camlp4
-
-ifeq ($(CAMLP4),camlp4)
-tools/compat5.cmo: tools/compat5.mlp
-	$(OCAMLC) -c -I $(MYCAMLP4LIB) -pp '$(CAMLP4O) $(CAMLP4FLAGS) -impl' -impl $<
-tools/compat5b.cmo: tools/compat5b.mlp
-	$(OCAMLC) -c -I $(MYCAMLP4LIB) -pp '$(CAMLP4O) $(CAMLP4FLAGS) -impl' -impl $<
-else
-tools/compat5.cmo: tools/compat5.ml
-	$(OCAMLC) -c $<
-endif
-
 ###########################################################################
-# Documentation : cf Makefile.doc
+# Csdp to micromega special targets
 ###########################################################################
 
-documentation: doc-$(WITHDOC)
-doc-all: doc
-doc-no:
+CSDPCERTCMO:=lib/clib.cma $(addprefix plugins/micromega/, \
+  mutils.cmo 	micromega.cmo \
+  sos_types.cmo sos_lib.cmo sos.cmo 	csdpcert.cmo )
 
-.PHONY: documentation doc-all doc-no
+$(CSDPCERT): $(call bestobj, $(CSDPCERTCMO))
+	$(SHOW)'OCAMLBEST -o $@'
+	$(HIDE)$(call bestocaml,,nums unix)
 
 ###########################################################################
-# Installation
+# tests
 ###########################################################################
 
-ifeq ($(LOCAL),true)
-install:
-	@echo "Nothing to install in a local build!"
-else
-install: install-coq install-coqide install-doc-$(WITHDOC)
-endif
-
-install-doc-all: install-doc
-install-doc-no:
-
-.PHONY: install install-doc-all install-doc-no
-
-#These variables are intended to be set by the caller to make
-#COQINSTALLPREFIX=
-#OLDROOT=
-
-  # Can be changed for a local installation (to make packages).
-  # You must NOT put a "/" at the end (Cygnus for win32 does not like "//").
+.PHONY: validate check test-suite $(ALLSTDLIB).v
 
-ifdef COQINSTALLPREFIX
-FULLBINDIR=$(BINDIR:"$(OLDROOT)%="$(COQINSTALLPREFIX)%)
-FULLCOQLIB=$(COQLIBINSTALL:"$(OLDROOT)%="$(COQINSTALLPREFIX)%)
-FULLCONFIGDIR=$(CONFIGDIR:"$(OLDROOT)%="$(COQINSTALLPREFIX)%)
-FULLDATADIR=$(DATADIR:"$(OLDROOT)%="$(COQINSTALLPREFIX)%)
-FULLMANDIR=$(MANDIR:"$(OLDROOT)%="$(COQINSTALLPREFIX)%)
-FULLEMACSLIB=$(EMACSLIB:"$(OLDROOT)%="$(COQINSTALLPREFIX)%)
-FULLCOQDOCDIR=$(COQDOCDIR:"$(OLDROOT)%="$(COQINSTALLPREFIX)%)
-FULLDOCDIR=$(DOCDIR:"$(OLDROOT)%="$(COQINSTALLPREFIX)%)
-else
-FULLBINDIR=$(BINDIR)
-FULLCOQLIB=$(COQLIBINSTALL)
-FULLCONFIGDIR=$(CONFIGDIR)
-FULLDATADIR=$(DATADIR)
-FULLMANDIR=$(MANDIR)
-FULLEMACSLIB=$(EMACSLIB)
-FULLCOQDOCDIR=$(COQDOCDIR)
-FULLDOCDIR=$(DOCDIR)
-endif
-
-.PHONY: install-coq install-coqlight install-binaries install-byte install-opt
-.PHONY: install-tools install-library install-library-light install-devfiles
-.PHONY: install-coq-info install-coq-manpages install-emacs install-latex
-
-install-coq: install-binaries install-library install-coq-info install-devfiles
-install-coqlight: install-binaries install-library-light
-
-install-binaries: install-tools
-	$(MKDIR) $(FULLBINDIR)
-	$(INSTALLBIN) $(COQC) $(COQTOPBYTE) $(COQTOPEXE) $(CHICKEN) $(FULLBINDIR)
-	$(MKDIR) $(FULLCOQLIB)/toploop
-	$(INSTALLBIN) $(TOPLOOPCMA) $(FULLCOQLIB)/toploop/
-ifeq ($(BEST),opt)
-	$(INSTALLBIN) $(TOPLOOPCMA:.cma=.cmxs) $(FULLCOQLIB)/toploop/
-endif
-
-
-install-tools:
-	$(MKDIR) $(FULLBINDIR)
-	# recopie des fichiers de style pour coqide
-	$(MKDIR) $(FULLCOQLIB)/tools/coqdoc
-	touch $(FULLCOQLIB)/tools/coqdoc/coqdoc.sty $(FULLCOQLIB)/tools/coqdoc/coqdoc.css # to have the mode according to umask (bug #1715)
-	$(INSTALLLIB) tools/coqdoc/coqdoc.css tools/coqdoc/coqdoc.sty $(FULLCOQLIB)/tools/coqdoc
-	$(INSTALLBIN) $(TOOLS) $(FULLBINDIR)
-
-# The list of .cmi to install, including the ones obtained
-# from .mli without .ml, and the ones obtained from .ml without .mli
-
-INSTALLCMI = $(sort \
-	$(filter-out checker/% ide/% tools/%, $(MLIFILES:.mli=.cmi)) \
-	$(foreach lib,$(CORECMA) $(PLUGINSCMA), $(addsuffix .cmi,$($(lib:.cma=_MLLIB_DEPENDENCIES)))))
-
-install-devfiles:
-	$(MKDIR) $(FULLBINDIR)
-	$(INSTALLBIN) $(COQMKTOP) $(FULLBINDIR)
-	$(MKDIR) $(FULLCOQLIB)
-	$(INSTALLSH)  $(FULLCOQLIB) $(LINKCMO) $(GRAMMARCMA)
-	$(INSTALLSH)  $(FULLCOQLIB) $(INSTALLCMI)
-ifeq ($(BEST),opt)
-	$(INSTALLSH)  $(FULLCOQLIB) $(LINKCMX) $(CORECMA:.cma=.a) $(STATICPLUGINS:.cma=.a)
-endif
-
-install-library:
-	$(MKDIR) $(FULLCOQLIB)
-	$(INSTALLSH) $(FULLCOQLIB) $(LIBFILES) $(PLUGINS)
-	$(MKDIR) $(FULLCOQLIB)/user-contrib
-ifndef CUSTOM
-	$(INSTALLLIB) $(DLLCOQRUN) $(FULLCOQLIB)
-endif
-ifeq ($(BEST),opt)
-	$(INSTALLLIB) $(LIBCOQRUN) $(FULLCOQLIB)
-	$(INSTALLSH) $(FULLCOQLIB) $(PLUGINSOPT)
-endif
-# csdpcert is not meant to be directly called by the user; we install
-# it with libraries
-	-$(MKDIR) $(FULLCOQLIB)/plugins/micromega
-	$(INSTALLBIN) $(CSDPCERT) $(FULLCOQLIB)/plugins/micromega
-	rm -f $(FULLCOQLIB)/revision
-	-$(INSTALLLIB) revision $(FULLCOQLIB)
-
-install-library-light:
-	$(MKDIR) $(FULLCOQLIB)
-	$(INSTALLSH) $(FULLCOQLIB) $(LIBFILESLIGHT) $(INITPLUGINS)
-	rm -f $(FULLCOQLIB)/revision
-	-$(INSTALLLIB) revision $(FULLCOQLIB)
-ifndef CUSTOM
-	$(INSTALLLIB) $(DLLCOQRUN) $(FULLCOQLIB)
-endif
-ifeq ($(BEST),opt)
-	$(INSTALLLIB) $(LIBCOQRUN) $(FULLCOQLIB)
-	$(INSTALLSH)  $(FULLCOQLIB) $(INITPLUGINSOPT)
-endif
+VALIDOPTS=$(if $(VERBOSE),,-silent) -o -m
 
-install-coq-info: install-coq-manpages install-emacs install-latex
+validate: $(CHICKEN) | $(ALLVO)
+	$(SHOW)'COQCHK <theories & plugins>'
+	$(HIDE)$(CHICKEN) -boot $(VALIDOPTS) $(ALLMODS)
 
-install-coq-manpages:
-	$(MKDIR) $(FULLMANDIR)/man1
-	$(INSTALLLIB) $(MANPAGES) $(FULLMANDIR)/man1
+$(ALLSTDLIB).v:
+	$(SHOW)'MAKE $(notdir $@)'
+	$(HIDE)echo "Require $(ALLMODS)." > $@
 
-install-emacs:
-	$(MKDIR) $(FULLEMACSLIB)
-	$(INSTALLLIB) tools/gallina-db.el tools/coq-font-lock.el tools/gallina-syntax.el tools/gallina.el tools/coq-inferior.el $(FULLEMACSLIB)
+MAKE_TSOPTS=-C test-suite -s VERBOSE=$(VERBOSE)
 
-# command to update TeX' kpathsea database
-#UPDATETEX = $(MKTEXLSR) /usr/share/texmf /var/spool/texmf $(BASETEXDIR) > /dev/null
+check: validate test-suite
 
-install-latex:
-	$(MKDIR) $(FULLCOQDOCDIR)
-	$(INSTALLLIB) tools/coqdoc/coqdoc.sty $(FULLCOQDOCDIR)	
-#	-$(UPDATETEX)
+test-suite: world $(ALLSTDLIB).v
+	$(MAKE) $(MAKE_TSOPTS) clean
+	$(MAKE) $(MAKE_TSOPTS) all
+	$(MAKE) $(MAKE_TSOPTS) report
 
 ###########################################################################
-# Documentation of the source code (using ocamldoc)
+# Default rules for compiling ML code
 ###########################################################################
 
-.PHONY: source-doc mli-doc ml-doc
-
-source-doc: mli-doc $(OCAMLDOCDIR)/coq.pdf
-
-$(OCAMLDOCDIR)/coq.tex: $(DOCMLIS:.mli=.cmi)
-	$(SHOW)'OCAMLDOC -latex -o $@'
-	$(HIDE)$(OCAMLFIND) ocamldoc -latex -rectypes -I $(MYCAMLP4LIB) $(MLINCLUDES)\
-	$(DOCMLIS) -noheader -t "Coq mlis documentation" \
-	-intro $(OCAMLDOCDIR)/docintro -o $@.tmp
-	$(SHOW)'OCAMLDOC utf8 fix'
-	$(HIDE)$(OCAMLDOCDIR)/fix-ocamldoc-utf8 $@.tmp
-	$(HIDE)cat $(OCAMLDOCDIR)/header.tex $@.tmp > $@
-	rm $@.tmp
-
-mli-doc: $(DOCMLIS:.mli=.cmi)
-	$(SHOW)'OCAMLDOC -html'
-	$(HIDE)$(OCAMLFIND) ocamldoc -charset utf-8 -html -rectypes -I +threads -I $(MYCAMLP4LIB) $(MLINCLUDES) \
-	$(DOCMLIS) -d $(OCAMLDOCDIR)/html -colorize-code \
-	-t "Coq mlis documentation" -intro $(OCAMLDOCDIR)/docintro \
-	-css-style style.css
-
-ml-dot: $(MLFILES)
-	$(OCAMLFIND) ocamldoc -dot -dot-reduce -rectypes -I +threads -I $(CAMLLIB) -I $(MYCAMLP4LIB) $(MLINCLUDES) \
-	$(filter $(addsuffix /%.ml,$(CORESRCDIRS)),$(MLFILES)) -o $(OCAMLDOCDIR)/coq.dot
-
-%_dep.png: %.dot
-	$(DOT) -Tpng $< -o $@
-
-%_types.dot: %.mli
-	$(OCAMLFIND) ocamldoc -rectypes $(MLINCLUDES) $(ODOCDOTOPTS) -dot-types -o $@ $<
-
-OCAMLDOC_MLLIBD = $(OCAMLFIND) ocamldoc -rectypes $(MLINCLUDES) $(ODOCDOTOPTS) -o $@ \
-  $(foreach lib,$(|:.mllib.d=_MLLIB_DEPENDENCIES),$(addsuffix .ml,$($(lib))))
-
-%.dot: | %.mllib.d
-	$(OCAMLDOC_MLLIBD)
-
-ml-doc:
-	$(OCAMLFIND) ocamldoc -charset utf-8 -html -rectypes -I +threads $(MLINCLUDES) $(COQIDEFLAGS) -d $(OCAMLDOCDIR) $(MLSTATICFILES)
-
-parsing/parsing.dot : | parsing/parsing.mllib.d parsing/highparsing.mllib.d
-	$(OCAMLDOC_MLLIBD)
-
-grammar/grammar.dot : | grammar/grammar.mllib.d
-	$(OCAMLDOC_MLLIBD)
+# Target for libraries .cma and .cmxa
 
-tactics/tactics.dot: | tactics/tactics.mllib.d ltac/ltac.mllib.d
-	$(OCAMLDOC_MLLIBD)
+# The dependency over the .mllib is somewhat artificial, since
+# ocamlc -a won't use this file, hence the $(filter-out ...) below.
+# But this ensures that the .cm(x)a is rebuilt when needed,
+# (especially when removing a module in the .mllib).
+# We used to have a "order-only" dependency over .mllib.d here,
+# but the -include mechanism should already ensure that we have
+# up-to-date dependencies.
 
-%.dot: %.mli
-	$(OCAMLFIND) ocamldoc -rectypes $(MLINCLUDES) $(ODOCDOTOPTS) -o $@ $<
+# Specific rule for kernel.cma, with $(VMBYTEFLAGS).
+# This helps loading dllcoqrun.so during an ocamldebug
+kernel/kernel.cma: kernel/kernel.mllib
+	$(SHOW)'OCAMLC -a -o $@'
+	$(HIDE)$(OCAMLC) $(MLINCLUDES) $(BYTEFLAGS) $(VMBYTEFLAGS) -a -o $@ $(filter-out %.mllib, $^)
 
-$(OCAMLDOCDIR)/%.pdf: $(OCAMLDOCDIR)/%.tex
-	$(SHOW)'PDFLATEX $*.tex'
-	$(HIDE)(cd $(OCAMLDOCDIR) ; pdflatex -interaction=batchmode $*.tex && pdflatex -interaction=batchmode $*.tex)
-	$(HIDE)(cd doc/tools/; show_latex_messages -no-overfull ../../$(OCAMLDOCDIR)/$*.log)
+%.cma: %.mllib
+	$(SHOW)'OCAMLC -a -o $@'
+	$(HIDE)$(OCAMLC) $(MLINCLUDES) $(BYTEFLAGS) -a -o $@ $(filter-out %.mllib, $^)
 
-###########################################################################
-### Special rules
-###########################################################################
+%.cmxa: %.mllib
+	$(SHOW)'OCAMLOPT -a -o $@'
+	$(HIDE)$(OCAMLOPT) $(MLINCLUDES) $(OPTFLAGS) -a -o $@ $(filter-out %.mllib, $^)
 
-dev/printers.cma: dev/printers.mllib
-	$(SHOW)'Testing $@'
-	$(HIDE)$(OCAMLC) $(MLINCLUDES) $(BYTEFLAGS) -thread $(SYSCMA) $(P4CMA) $(filter-out %.mllib, $^) -o test-printer
-	@rm -f test-printer
-	$(SHOW)'OCAMLC -a $@'   
-	$(HIDE)$(OCAMLC) $(MLINCLUDES) $(BYTEFLAGS) -thread $(SYSCMA) $(P4CMA) $(filter-out %.mllib, $^) -linkall -a -o $@
+# For plugin packs
 
-ide/coqide_main.ml: ide/coqide_main.ml4 config/Makefile # no camlp4deps here
-	$(SHOW)'CAMLP4O   $<'
-	$(HIDE)$(CAMLP4O) $(CAMLP4FLAGS) $(PR_O) $(CAMLP4USE) -D$(IDEINT) -impl $< -o $@
-
-# pretty printing of the revision number when compiling a checked out
-# source tree
-.PHONY: revision
-
-revision:
-	$(SHOW)'CHECK revision'
-	$(HIDE)rm -f revision.new
-ifeq ($(CHECKEDOUT),svn)
-	$(HIDE)set -e; \
-        if test -x "`which svn`"; then \
-	  export LC_ALL=C;\
-	  svn info . | sed -ne '/URL/s/.*\/\([^\/]\{1,\}\)/\1/p' > revision.new; \
-	  svn info . | sed -ne '/Revision/s/Revision: \([0-9]\{1,\}\)/\1/p'>> revision.new; \
-	fi
-endif
-ifeq ($(CHECKEDOUT),gnuarch)
-	$(HIDE)set -e; \
-        if test -x "`which tla`"; then \
-	  LANG=C; export LANG; \
-	  tla tree-version  >  revision.new ; \
-	  tla tree-revision | sed -ne 's|.*--||p' >> revision.new ; \
-	fi
-endif
-ifeq ($(CHECKEDOUT),git)
-	$(HIDE)set -e; \
-	if test -x "`which git`"; then \
-	  LANG=C; export LANG; \
-	  GIT_BRANCH=$$(git branch -a | sed -ne '/^\* /s/^\* \(.*\)/\1/p'); \
-	  GIT_HOST=$$(hostname); \
-	  GIT_PATH=$$(pwd); \
-	  (echo "$${GIT_HOST}:$${GIT_PATH},$${GIT_BRANCH}") > revision.new; \
-	  (echo "$$(git log -1 --pretty='format:%H')") >> revision.new; \
-	fi
-endif
-	$(HIDE)set -e; \
-	if test -e revision.new; then \
-          if test -e revision; then \
-	    if test "`cat revision`" = "`cat revision.new`" ; then \
-	       rm -f revision.new; \
-            else \
-               mv -f revision.new revision; \
-            fi; \
-          else \
-            mv -f revision.new revision; \
-          fi \
-	fi
+# Note: both ocamlc -pack and ocamlopt -pack will create the same .cmi, and there's
+# apparently no way to avoid that (no -intf-suffix hack as below).
+# We at least ensure that these two commands won't run at the same time, by a fake
+# dependency from the packed .cmx to the packed .cmo.
 
-###########################################################################
-# Default rules
-###########################################################################
+%.cmo: %.mlpack
+	$(SHOW)'OCAMLC -pack -o $@'
+	$(HIDE)$(OCAMLC) $(MLINCLUDES) $(BYTEFLAGS) -pack -o $@ $(filter-out %.mlpack, $^)
 
-## Three flavor of flags: checker/* ide/* and normal files
+%.cmx: %.mlpack %.cmo
+	$(SHOW)'OCAMLOPT -pack -o $@'
+	$(HIDE)$(OCAMLOPT) $(MLINCLUDES) $(OPTFLAGS) -pack -o $@ $(filter-out %.mlpack %.cmo, $^)
 
 COND_BYTEFLAGS= \
- $(if $(filter checker/%,$<), $(CHKLIBS) -thread, \
-   $(if $(filter ide/%,$<), $(COQIDEFLAGS), \
-     $(if $(filter tools/fake_ide% tools/coq_makefile%,$<), -I ide,) $(MLINCLUDES) -thread)) $(BYTEFLAGS)
+ $(if $(filter tools/fake_ide% tools/coq_makefile%,$<), -I ide,) $(MLINCLUDES) $(BYTEFLAGS)
 
 COND_OPTFLAGS= \
- $(if $(filter checker/%,$<), $(CHKLIBS) -thread, \
-   $(if $(filter ide/%,$<), $(COQIDEFLAGS), \
-     $(if $(filter tools/fake_ide% tools/coq_makefile%,$<), -I ide,) $(MLINCLUDES) -thread)) $(OPTFLAGS)
-
-%.o: %.c
-	$(SHOW)'OCAMLC    $<'
-	$(HIDE)cd $(dir $<) && $(OCAMLC) -ccopt "$(CFLAGS)" -c $(notdir $<)
-
-%.o: %.rc
-	$(SHOW)'WINDRES    $<'
-	$(HIDE)i686-w64-mingw32-windres -i $< -o $@
+ $(if $(filter tools/fake_ide% tools/coq_makefile%,$<), -I ide,) $(MLINCLUDES) $(OPTFLAGS)
 
 %.cmi: %.mli
 	$(SHOW)'OCAMLC    $<'
@@ -1071,117 +569,120 @@ $(MLWITHOUTMLI:.ml=.cmx): %.cmx: %.cmi  # for .ml with .mli this is already the
 
 $(MLWITHOUTMLI:.ml=.cmi): %.cmi: %.cmo
 
+# NB: the *_FORPACK variables are generated in *.mlpack.d by ocamllibdep
+# The only exceptions are the sources of the csdpcert binary.
+# To avoid warnings, we set them manually here:
+plugins/micromega/sos_lib_FORPACK:=
+plugins/micromega/sos_FORPACK:=
+plugins/micromega/sos_print_FORPACK:=
+plugins/micromega/csdpcert_FORPACK:=
+
+plugins/%.cmx: plugins/%.ml
+	$(SHOW)'OCAMLOPT  $<'
+	$(HIDE)$(OCAMLOPT) $(COND_OPTFLAGS) $(HACKMLI) $($(@:.cmx=_FORPACK)) -c $<
+
 %.cmx: %.ml
 	$(SHOW)'OCAMLOPT  $<'
 	$(HIDE)$(OCAMLOPT) $(COND_OPTFLAGS) $(HACKMLI) -c $<
 
-%.cmxs: %.cmxa
-	$(SHOW)'OCAMLOPT -shared -o $@'
-ifeq ($(HASNATDYNLINK),os5fixme)
-	$(HIDE)dev/ocamlopt_shared_os5fix.sh "$(OCAMLOPT)" $@
-else
-	$(HIDE)$(OCAMLOPT) -linkall -shared -o $@ $<
-endif
-
 %.cmxs: %.cmx
 	$(SHOW)'OCAMLOPT -shared -o $@'
 	$(HIDE)$(OCAMLOPT) -shared -o $@ $<
 
+%.cmxs: %.cmxa
+	$(SHOW)'OCAMLOPT -shared -o $@'
+	$(HIDE)$(OCAMLOPT) -linkall -shared -o $@ $<
+
 %.ml: %.mll
 	$(SHOW)'OCAMLLEX  $<'
 	$(HIDE)$(OCAMLLEX) -o $@ "$*.mll"
 
-plugins/%_mod.ml: plugins/%.mllib
-	$(SHOW)'ECHO... > $@'
-	$(HIDE)sed -e "s/\([^ ]\{1,\}\)/let _=Mltop.add_known_module\"\1\" /g" $< > $@
-	$(HIDE)echo "let _=Mltop.add_known_module\"$(notdir $*)\"" >> $@
-
-%.ml: %.ml4 | $(CAMLP4DEPS)
+%.ml: %.ml4 $(CAMLP4DEPS)
 	$(SHOW)'CAMLP4O   $<'
-	$(HIDE)$(CAMLP4O) $(CAMLP4FLAGS) $(PR_O) \
+	$(HIDE)$(CAMLP4O) -I $(MYCAMLP4LIB) $(PR_O) \
 	  $(CAMLP4DEPS) $(CAMLP4USE) $(CAMLP4COMPAT) -impl $< -o $@
 
-%.vo %.glob: %.v theories/Init/Prelude.vo $(VO_TOOLS_DEP)
-	$(SHOW)'COQC      $<'
-	$(HIDE)rm -f $*.glob 
-	$(HIDE)$(BOOTCOQC) $<
-ifdef VALIDATE
-	$(SHOW)'COQCHK    $(call vo_to_mod,$@)'
-	$(HIDE)$(CHICKEN) -boot -silent -norec $(call vo_to_mod,$@) \
-	  || ( RV=$$?; rm -f "$@"; exit $${RV} )
-endif
 
 ###########################################################################
-# Dependencies
+# Dependencies of ML code
 ###########################################################################
 
-# Since OCaml 3.12.1, we could use again ocamldep directly, thanks to
-# the option -ml-synonym
-
-OCAMLDEP_NG = $(OCAMLFIND) ocamldep -slash -ml-synonym .ml4
-
-checker/%.ml.d: $(D_DEPEND_BEFORE_SRC) checker/%.ml $(D_DEPEND_AFTER_SRC) $(GENFILES)
-	$(SHOW)'OCAMLDEP  $<'
-	$(HIDE)$(OCAMLDEP_NG) $(LOCALCHKLIBS) "$<" $(TOTARGET)
-
-checker/%.mli.d: $(D_DEPEND_BEFORE_SRC) checker/%.mli $(D_DEPEND_AFTER_SRC) $(GENFILES)
-	$(SHOW)'OCAMLDEP  $<'
-	$(HIDE)$(OCAMLDEP_NG) $(LOCALCHKLIBS) "$<" $(TOTARGET)
+# Ocamldep is now used directly again (thanks to -ml-synonym in OCaml >= 3.12)
+OCAMLDEP = $(OCAMLFIND) ocamldep -slash -ml-synonym .ml4 -ml-synonym .mlpack
 
 %.ml.d: $(D_DEPEND_BEFORE_SRC) %.ml $(D_DEPEND_AFTER_SRC) $(GENFILES)
 	$(SHOW)'OCAMLDEP  $<'
-	$(HIDE)$(OCAMLDEP_NG) $(DEPFLAGS) "$<" $(TOTARGET)
+	$(HIDE)$(OCAMLDEP) $(DEPFLAGS) "$<" $(TOTARGET)
 
 %.mli.d: $(D_DEPEND_BEFORE_SRC) %.mli $(D_DEPEND_AFTER_SRC) $(GENFILES)
 	$(SHOW)'OCAMLDEP  $<'
-	$(HIDE)$(OCAMLDEP_NG) $(DEPFLAGS) "$<" $(TOTARGET)
-
-checker/%.mllib.d: $(D_DEPEND_BEFORE_SRC) checker/%.mllib $(D_DEPEND_AFTER_SRC) $(OCAMLLIBDEP) $(GENFILES)
-	$(SHOW)'OCAMLLIBDEP  $<'
-	$(HIDE)$(OCAMLLIBDEP) $(LOCALCHKLIBS) "$<" $(TOTARGET)
+	$(HIDE)$(OCAMLDEP) $(DEPFLAGS) "$<" $(TOTARGET)
 
-dev/%.mllib.d: $(D_DEPEND_BEFORE_SRC) dev/%.mllib $(D_DEPEND_AFTER_SRC) $(OCAMLLIBDEP) $(GENFILES)
+%.mllib.d: $(D_DEPEND_BEFORE_SRC) %.mllib $(D_DEPEND_AFTER_SRC) $(OCAMLLIBDEP) $(GENFILES)
 	$(SHOW)'OCAMLLIBDEP  $<'
-	$(HIDE)$(OCAMLLIBDEP) $(DEPFLAGS) -I dev "$<" $(TOTARGET)
+	$(HIDE)$(OCAMLLIBDEP) $(DEPFLAGS) "$<" $(TOTARGET)
 
-%.mllib.d: $(D_DEPEND_BEFORE_SRC) %.mllib $(D_DEPEND_AFTER_SRC) $(OCAMLLIBDEP) $(GENFILES)
+%.mlpack.d: $(D_DEPEND_BEFORE_SRC) %.mlpack $(D_DEPEND_AFTER_SRC) $(OCAMLLIBDEP) $(GENFILES)
 	$(SHOW)'OCAMLLIBDEP  $<'
 	$(HIDE)$(OCAMLLIBDEP) $(DEPFLAGS) "$<" $(TOTARGET)
 
-%.v.d: $(D_DEPEND_BEFORE_SRC) %.v $(D_DEPEND_AFTER_SRC) $(COQDEPBOOT) $(GENVFILES)
-	$(SHOW)'COQDEP    $<'
-	$(HIDE)$(COQDEPBOOT) -boot $(DEPNATDYN) "$<" $(TOTARGET)
+###########################################################################
+# Compilation of .v files
+###########################################################################
 
-%_stubs.c.d: $(D_DEPEND_BEFORE_SRC) %_stubs.c $(D_DEPEND_AFTER_SRC)
-	$(SHOW)'CCDEP	$<'
-	$(HIDE)echo "$@ $(@:.c.d=.o): $(@:.c.d=.c)" > $@
+# NB: for make world, no need to mention explicitly the .cmxs of the plugins,
+# since they are all mentioned in at least one Declare ML Module in some .v
 
-%.c.d: $(D_DEPEND_BEFORE_SRC) %.c $(D_DEPEND_AFTER_SRC) $(GENHFILES)
-	$(SHOW)'CCDEP     $<'
-	$(HIDE)$(OCAMLC) -ccopt "-MM -MQ $@ -MQ $(<:.c=.o) -isystem $(CAMLHLIB)" $< $(TOTARGET)
+coqlib: theories plugins
 
-###########################################################################
-# this sets up developper supporting stuff
-###########################################################################
+theories: $(THEORIESVO)
+plugins: $(PLUGINSVO)
 
-.PHONY: devel otags
-devel: $(DEBUGPRINTERS)
+.PHONY: coqlib theories plugins
 
-# NOTA : otags only accepts camlp4 as preprocessor, so the following rule
-# won't build tags of .ml4 when compiling with camlp5
-otags:
-	otags $(MLIFILES) $(filter-out configure.ml, $(MLSTATICFILES)) \
-	$(if $(filter camlp5,$(CAMLP4)), , \
-          -pa op -pa g -pa m -pa rq $(addprefix -pa , $(CAMLP4DEPS)) \
-          $(addprefix -impl , $(ML4FILES)))
+# One of the .v files is macro-generated
 
+theories/Numbers/Natural/BigN/NMake_gen.v: theories/Numbers/Natural/BigN/NMake_gen.ml
+	$(OCAML) $< $(TOTARGET)
+
+# The .vo files in Init are built with the -noinit option
+
+theories/Init/%.vo theories/Init/%.glob: theories/Init/%.v $(VO_TOOLS_DEP)
+	$(SHOW)'COQC $(COQ_XML) -noinit $<'
+	$(HIDE)rm -f theories/Init/$*.glob
+	$(HIDE)$(BOOTCOQC) $< $(COQ_XML) -noinit -R theories Coq
+
+# The general rule for building .vo files :
+
+%.vo %.glob: %.v theories/Init/Prelude.vo $(VO_TOOLS_DEP)
+	$(SHOW)'COQC      $<'
+	$(HIDE)rm -f $*.glob
+	$(HIDE)$(BOOTCOQC) $<
+ifdef VALIDATE
+	$(SHOW)'COQCHK    $(call vo_to_mod,$@)'
+	$(HIDE)$(CHICKEN) -boot -silent -norec $(call vo_to_mod,$@) \
+	  || ( RV=$$?; rm -f "$@"; exit $${RV} )
+endif
+
+# Dependencies of .v files
+
+%.v.d: $(D_DEPEND_BEFORE_SRC) %.v $(D_DEPEND_AFTER_SRC) $(COQDEPBOOT) $(GENVFILES)
+	$(SHOW)'COQDEP    $<'
+	$(HIDE)$(COQDEPBOOT) -boot $(DEPNATDYN) "$<" $(TOTARGET)
 
 ###########################################################################
 
 # To speed-up things a bit, let's dissuade make to attempt rebuilding makefiles
 
-Makefile Makefile.build Makefile.common config/Makefile : ;
+Makefile $(wildcard Makefile.*) config/Makefile : ;
+
+# Final catch-all rule.
+# Usually, 'make' would display such an error itself.
+# But if the target has some declared dependencies (e.g. in a .d)
+# but no building rule, 'make' succeeds silently (see bug #4812).
 
+%:
+	@echo "Error: no rule to make target $@ (or missing .PHONY)" && false
 
 # For emacs: 
 # Local Variables: 
diff --git a/Makefile.checker b/Makefile.checker
new file mode 100644
index 000000000..3ea0baced
--- /dev/null
+++ b/Makefile.checker
@@ -0,0 +1,86 @@
+#######################################################################
+#  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       #
+#######################################################################
+
+## Makefile rules for building Coqchk
+
+## NB: For the moment, the build system of Coqchk is part of
+## the one of Coq. In particular, this Makefile.checker is included in
+## Makefile.build. Please ensure that the rules define here are
+## indeed specific to files of the form checker/*
+
+# The binaries
+
+CHICKENBYTE:=bin/coqchk.byte$(EXE)
+CHICKEN:=bin/coqchk$(EXE)
+
+# The sources
+
+CHKLIBS:= -I config -I lib -I checker
+
+## NB: currently, both $(OPTFLAGS) and $(BYTEFLAGS) contain -thread
+
+# The rules
+
+ifeq ($(BEST),opt)
+$(CHICKEN): checker/check.cmxa checker/main.ml
+	$(SHOW)'OCAMLOPT -o $@'
+	$(HIDE)$(OCAMLOPT) $(SYSCMXA) $(CHKLIBS) $(OPTFLAGS) $(LINKMETADATA) -o $@ $^
+	$(STRIP) $@
+	$(CODESIGN) $@
+else
+$(CHICKEN): $(CHICKENBYTE)
+	cp $< $@
+endif
+
+$(CHICKENBYTE): checker/check.cma checker/main.ml
+	$(SHOW)'OCAMLC -o $@'
+	$(HIDE)$(OCAMLC) $(SYSCMA) $(CHKLIBS) $(BYTEFLAGS) $(CUSTOM) -o $@ $^
+
+checker/check.cma: checker/check.mllib | md5chk
+	$(SHOW)'OCAMLC -a -o $@'
+	$(HIDE)$(OCAMLC) $(CHKLIBS) $(BYTEFLAGS) -a -o $@ $(filter-out %.mllib, $^)
+
+checker/check.cmxa: checker/check.mllib | md5chk
+	$(SHOW)'OCAMLOPT -a -o $@'
+	$(HIDE)$(OCAMLOPT) $(CHKLIBS) $(OPTFLAGS) -a -o $@ $(filter-out %.mllib, $^)
+
+checker/%.ml.d: checker/%.ml
+	$(SHOW)'OCAMLDEP  $<'
+	$(HIDE)$(OCAMLFIND) ocamldep -slash $(CHKLIBS) "$<" $(TOTARGET)
+
+checker/%.mli.d: checker/%.mli
+	$(SHOW)'OCAMLDEP  $<'
+	$(HIDE)$(OCAMLFIND) ocamldep -slash $(CHKLIBS) "$<" $(TOTARGET)
+
+checker/%.mllib.d: checker/%.mllib | $(OCAMLLIBDEP)
+	$(SHOW)'OCAMLLIBDEP  $<'
+	$(HIDE)$(OCAMLLIBDEP) $(CHKLIBS) "$<" $(TOTARGET)
+
+checker/%.cmi: checker/%.mli
+	$(SHOW)'OCAMLC    $<'
+	$(HIDE)$(OCAMLC) $(CHKLIBS) $(BYTEFLAGS) -c $<
+
+checker/%.cmo: checker/%.ml
+	$(SHOW)'OCAMLC    $<'
+	$(HIDE)$(OCAMLC) $(CHKLIBS) $(BYTEFLAGS) -c $<
+
+checker/%.cmx: checker/%.ml
+	$(SHOW)'OCAMLOPT  $<'
+	$(HIDE)$(OCAMLOPT) $(CHKLIBS) $(OPTFLAGS) $(HACKMLI) -c $<
+
+md5chk:
+	$(SHOW)'MD5SUM cic.mli'
+	$(HIDE)if grep -q `$(MD5SUM) checker/cic.mli` checker/values.ml; \
+	       then true; else echo "Error: outdated checker/values.ml"; false; fi
+
+.PHONY: md5chk
+
+# For emacs:
+# Local Variables:
+# mode: makefile
+# End:
diff --git a/Makefile.ci b/Makefile.ci
new file mode 100644
index 000000000..e4b5832f6
--- /dev/null
+++ b/Makefile.ci
@@ -0,0 +1,11 @@
+CI_TARGETS=ci-all ci-hott ci-math-comp ci-compcert ci-sf ci-cpdt \
+           ci-color ci-math-classes ci-tlc ci-fiat-crypto \
+           ci-coquelicot ci-flocq ci-iris-coq ci-metacoq ci-geocoq \
+           ci-unimath
+
+.PHONY: $(CI_TARGETS)
+
+# Generic rule, we use make to easy travis integraton with mixed rules
+$(CI_TARGETS): ci-%:
+	./dev/ci/ci-$*.sh
+
diff --git a/Makefile.common b/Makefile.common
index 86a7ea847..2cf4d0169 100644
--- a/Makefile.common
+++ b/Makefile.common
@@ -14,19 +14,32 @@
 
 COQMKTOP:=bin/coqmktop$(EXE) 
 
-COQC:=bin/coqc$(EXE)
-
 COQTOPBYTE:=bin/coqtop.byte$(EXE)
 COQTOPEXE:=bin/coqtop$(EXE)
 
-CHICKENBYTE:=bin/coqchk.byte$(EXE)
-CHICKEN:=bin/coqchk$(EXE)
+COQDEP:=bin/coqdep$(EXE)
+COQMAKEFILE:=bin/coq_makefile$(EXE)
+GALLINA:=bin/gallina$(EXE)
+COQTEX:=bin/coq-tex$(EXE)
+COQWC:=bin/coqwc$(EXE)
+COQDOC:=bin/coqdoc$(EXE)
+COQC:=bin/coqc$(EXE)
+COQWORKMGR:=bin/coqworkmgr$(EXE)
 
-ifeq ($(CAMLP4),camlp4)
-CAMLP4MOD:=camlp4lib
-else
-CAMLP4MOD:=gramlib
-endif
+TOOLS:=$(COQDEP) $(COQMAKEFILE) $(GALLINA) $(COQTEX) $(COQWC) $(COQDOC) $(COQC)\
+	$(COQWORKMGR)
+
+COQDEPBOOT:=bin/coqdep_boot$(EXE)
+OCAMLLIBDEP:=bin/ocamllibdep$(EXE)
+FAKEIDE:=bin/fake_ide$(EXE)
+
+PRIVATEBINARIES:=$(FAKEIDE) $(OCAMLLIBDEP) $(COQDEPBOOT)
+
+CSDPCERT:=plugins/micromega/csdpcert$(EXE)
+
+###########################################################################
+# Object and Source files
+###########################################################################
 
 ifeq ($(HASNATDYNLINK)-$(BEST),true-opt)
   DEPNATDYN:=
@@ -39,118 +52,22 @@ INSTALLLIB:=install -m 644
 INSTALLSH:=./install.sh
 MKDIR:=install -d
 
-COQIDEBYTE:=bin/coqide.byte$(EXE)
-COQIDE:=bin/coqide$(EXE)
-COQIDEAPP:=bin/CoqIDE_$(VERSION).app
-COQIDEINAPP:=$(COQIDEAPP)/Contents/MacOS/coqide
-
-ifeq ($(BEST),opt)
-OPT:=opt
-else
-OPT:=
-endif
-
-BESTOBJ:=$(if $(OPT),.cmx,.cmo)
-BESTLIB:=$(if $(OPT),.cmxa,.cma)
-BESTDYN:=$(if $(OPT),.cmxs,.cma)
-
-COQBINARIES:= $(COQMKTOP) \
-  $(COQTOPBYTE) $(COQTOPEXE) \
-  $(CHICKENBYTE) $(CHICKEN)
-
-CSDPCERT:=plugins/micromega/csdpcert$(EXE)
-
 CORESRCDIRS:=\
-  config 	lib		kernel		kernel/byterun	library \
-  proofs 	tactics 	pretyping	interp		stm \
-  toplevel	parsing 	printing	intf	engine	ltac
+  config 	lib		kernel	intf	kernel/byterun	library \
+  engine 	pretyping	interp	proofs	parsing 	printing \
+  tactics 	vernac		stm		toplevel 	ltac
 
-PLUGINS:=\
+PLUGINDIRS:=\
   omega		romega 		micromega 	quote \
   setoid_ring 	extraction 	fourier \
   cc 		funind 		firstorder 	derive \
-  rtauto 	nsatz           syntax          decl_mode	btauto
+  rtauto 	nsatz           syntax          decl_mode	btauto \
+  ssrmatching
 
 SRCDIRS:=\
   $(CORESRCDIRS)  \
   tools 	tools/coqdoc	\
-  $(addprefix plugins/, $(PLUGINS))
-
-IDESRCDIRS:= $(CORESRCDIRS) ide ide/utils
-
-CHKSRCDIRS:= config lib checker
-
-###########################################################################
-# Tools
-###########################################################################
-
-COQDEP:=bin/coqdep$(EXE)
-COQDEPBOOT:=bin/coqdep_boot$(EXE)
-OCAMLLIBDEP:=bin/ocamllibdep$(EXE)
-COQMAKEFILE:=bin/coq_makefile$(EXE)
-GALLINA:=bin/gallina$(EXE)
-COQTEX:=bin/coq-tex$(EXE)
-COQWC:=bin/coqwc$(EXE)
-COQDOC:=bin/coqdoc$(EXE)
-FAKEIDE:=bin/fake_ide$(EXE)
-COQWORKMGR:=bin/coqworkmgr$(EXE)
-
-TOOLS:=$(COQDEP) $(COQMAKEFILE) $(GALLINA) $(COQTEX) $(COQWC) $(COQDOC) $(COQC)\
-	$(COQWORKMGR)
-
-PRIVATEBINARIES:=$(FAKEIDE) $(OCAMLLIBDEP) $(COQDEPBOOT)
-
-###########################################################################
-# Documentation
-###########################################################################
-
-LATEX:=latex
-BIBTEX:=BIBINPUTS=.: bibtex -min-crossrefs=10
-MAKEINDEX:=makeindex
-PDFLATEX:=pdflatex
-DVIPS:=dvips
-FIG2DEV:=fig2dev
-CONVERT:=convert
-HEVEA:=hevea
-HACHA:=hacha
-HEVEAOPTS:=-fix -exec xxdate.exe
-HEVEALIB:=/usr/local/lib/hevea:/usr/lib/hevea
-HTMLSTYLE:=simple
-export TEXINPUTS:=$(HEVEALIB):
-COQTEXOPTS:=-boot -n 72 -sl -small
-
-DOCCOMMON:=doc/common/version.tex doc/common/title.tex doc/common/macros.tex 
-
-REFMANCOQTEXFILES:=$(addprefix doc/refman/, \
-  RefMan-gal.v.tex RefMan-ext.v.tex \
-  RefMan-mod.v.tex RefMan-tac.v.tex \
-  RefMan-cic.v.tex RefMan-lib.v.tex \
-  RefMan-tacex.v.tex RefMan-syn.v.tex \
-  RefMan-oth.v.tex RefMan-ltac.v.tex \
-  RefMan-decl.v.tex RefMan-pro.v.tex RefMan-sch.v.tex \
-  Cases.v.tex Coercion.v.tex CanonicalStructures.v.tex Extraction.v.tex \
-  Program.v.tex Omega.v.tex Micromega.v.tex Polynom.v.tex Nsatz.v.tex \
-  Setoid.v.tex Classes.v.tex Universes.v.tex \
-  Misc.v.tex)
-
-REFMANTEXFILES:=$(addprefix doc/refman/, \
-  headers.sty Reference-Manual.tex \
-  RefMan-pre.tex RefMan-int.tex RefMan-com.tex \
-  RefMan-uti.tex RefMan-ide.tex RefMan-add.tex RefMan-modr.tex \
-  AsyncProofs.tex ) \
-  $(REFMANCOQTEXFILES) \
-
-REFMANEPSFILES:=doc/refman/coqide.eps doc/refman/coqide-queries.eps
-
-REFMANFILES:=$(REFMANTEXFILES) $(DOCCOMMON) $(REFMANEPSFILES) doc/refman/biblio.bib
-
-REFMANPNGFILES:=$(REFMANEPSFILES:.eps=.png)
-
-
-
-###########################################################################
-# Object and Source files 
-###########################################################################
+  $(addprefix plugins/, $(PLUGINDIRS))
 
 COQRUN := coqrun
 LIBCOQRUN:=kernel/byterun/lib$(COQRUN).a
@@ -166,105 +83,63 @@ BYTERUN:=$(addprefix kernel/byterun/, \
 
 CORECMA:=lib/clib.cma lib/lib.cma kernel/kernel.cma library/library.cma \
         engine/engine.cma pretyping/pretyping.cma interp/interp.cma proofs/proofs.cma \
-        parsing/parsing.cma printing/printing.cma tactics/tactics.cma \
+        parsing/parsing.cma printing/printing.cma tactics/tactics.cma vernac/vernac.cma \
 	stm/stm.cma toplevel/toplevel.cma parsing/highparsing.cma ltac/ltac.cma
 
 TOPLOOPCMA:=stm/proofworkertop.cma stm/tacworkertop.cma stm/queryworkertop.cma
 
-GRAMMARCMA:=tools/compat5.cmo grammar/grammar.cma
-
-OMEGACMA:=plugins/omega/omega_plugin.cma
-ROMEGACMA:=plugins/romega/romega_plugin.cma
-MICROMEGACMA:=plugins/micromega/micromega_plugin.cma
-QUOTECMA:=plugins/quote/quote_plugin.cma
-RINGCMA:=plugins/setoid_ring/newring_plugin.cma
-NSATZCMA:=plugins/nsatz/nsatz_plugin.cma
-FOURIERCMA:=plugins/fourier/fourier_plugin.cma
-EXTRACTIONCMA:=plugins/extraction/extraction_plugin.cma
-FUNINDCMA:=plugins/funind/recdef_plugin.cma
-FOCMA:=plugins/firstorder/ground_plugin.cma
-CCCMA:=plugins/cc/cc_plugin.cma
-BTAUTOCMA:=plugins/btauto/btauto_plugin.cma
-RTAUTOCMA:=plugins/rtauto/rtauto_plugin.cma
-NATSYNTAXCMA:=plugins/syntax/nat_syntax_plugin.cma
-OTHERSYNTAXCMA:=$(addprefix plugins/syntax/, \
-        z_syntax_plugin.cma \
-        numbers_syntax_plugin.cma \
-        r_syntax_plugin.cma \
-	ascii_syntax_plugin.cma \
-        string_syntax_plugin.cma )
-DECLMODECMA:=plugins/decl_mode/decl_mode_plugin.cma
-DERIVECMA:=plugins/derive/derive_plugin.cma
-
-PLUGINSCMA:=$(OMEGACMA) $(ROMEGACMA) $(MICROMEGACMA) $(DECLMODECMA) \
-        $(QUOTECMA) $(RINGCMA) \
-        $(FOURIERCMA) $(EXTRACTIONCMA) \
-        $(CCCMA)  $(FOCMA) $(RTAUTOCMA) $(BTAUTOCMA) \
-        $(FUNINDCMA) $(NSATZCMA) $(NATSYNTAXCMA) $(OTHERSYNTAXCMA) \
-	$(DERIVECMA)
-
-ifneq ($(HASNATDYNLINK),false)
- STATICPLUGINS:=
- INITPLUGINS:=$(EXTRACTIONCMA) $(FOCMA) $(CCCMA) \
-	$(FUNINDCMA) $(NATSYNTAXCMA)
- INITPLUGINSOPT:=$(INITPLUGINS:.cma=.cmxs)
- PLUGINS:=$(PLUGINSCMA)
- PLUGINSOPT:=$(PLUGINSCMA:.cma=.cmxs)
-else
-ifeq ($(BEST),byte)
- STATICPLUGINS:=
- INITPLUGINS:=$(EXTRACTIONCMA) $(FOCMA) $(CCCMA) \
-	$(FUNINDCMA) $(NATSYNTAXCMA)
- INITPLUGINSOPT:=$(INITPLUGINS:.cma=.cmxs)
- PLUGINS:=$(PLUGINSCMA)
- PLUGINSOPT:=$(PLUGINSCMA:.cma=.cmxs)
-else
- STATICPLUGINS:=$(PLUGINSCMA)
- INITPLUGINS:=
- INITPLUGINSOPT:=
- PLUGINS:=
- PLUGINSOPT:=
-endif
-endif
-
-LINKCMO:=$(CORECMA) $(STATICPLUGINS)
-LINKCMX:=$(CORECMA:.cma=.cmxa) $(STATICPLUGINS:.cma=.cmxa)
-
-IDEDEPS:=lib/clib.cma lib/errors.cmo lib/spawn.cmo
-IDECMA:=ide/ide.cma
-IDETOPLOOPCMA=ide/coqidetop.cma
-
-LINKIDE:=$(IDEDEPS) $(IDECDEPS) $(IDECMA) ide/coqide_main.ml
-LINKIDEOPT:=$(IDEOPTCDEPS) $(patsubst %.cma,%.cmxa,$(IDEDEPS:.cmo=.cmx)) $(IDECMA:.cma=.cmxa) ide/coqide_main.ml
+GRAMMARCMA:=grammar/compat5.cmo grammar/grammar.cma
 
 # modules known by the toplevel of Coq
 
 OBJSMOD:=$(shell cat $(CORECMA:.cma=.mllib))
 
-IDEMOD:=$(shell cat ide/ide.mllib)
-
-# coqmktop, coqc
-
-COQENVCMO:=lib/clib.cma lib/errors.cmo
-
-COQMKTOPCMO:=$(COQENVCMO) tools/tolink.cmo tools/coqmktop.cmo
-
-COQCCMO:=$(COQENVCMO) toplevel/usage.cmo tools/coqc.cmo
-
-## Misc
-
-CSDPCERTCMO:=$(addprefix plugins/micromega/, \
-  mutils.cmo 	micromega.cmo \
-  sos_types.cmo sos_lib.cmo sos.cmo 	csdpcert.cmo )
-
-DEBUGPRINTERS:=dev/top_printers.cmo dev/vm_printers.cmo dev/printers.cma
-
-COQDEPCMO:=$(COQENVCMO) lib/minisys.cmo lib/system.cmo tools/coqdep_lexer.cmo tools/coqdep_common.cmo tools/coqdep.cmo
-
-COQDOCCMO:=lib/clib.cma $(addprefix tools/coqdoc/, \
-  cdglobals.cmo alpha.cmo index.cmo tokens.cmo output.cmo cpretty.cmo main.cmo )
+###########################################################################
+# plugins object files
+###########################################################################
+
+OMEGACMO:=plugins/omega/omega_plugin.cmo
+ROMEGACMO:=plugins/romega/romega_plugin.cmo
+MICROMEGACMO:=plugins/micromega/micromega_plugin.cmo
+QUOTECMO:=plugins/quote/quote_plugin.cmo
+RINGCMO:=plugins/setoid_ring/newring_plugin.cmo
+NSATZCMO:=plugins/nsatz/nsatz_plugin.cmo
+FOURIERCMO:=plugins/fourier/fourier_plugin.cmo
+EXTRACTIONCMO:=plugins/extraction/extraction_plugin.cmo
+FUNINDCMO:=plugins/funind/recdef_plugin.cmo
+FOCMO:=plugins/firstorder/ground_plugin.cmo
+CCCMO:=plugins/cc/cc_plugin.cmo
+BTAUTOCMO:=plugins/btauto/btauto_plugin.cmo
+RTAUTOCMO:=plugins/rtauto/rtauto_plugin.cmo
+NATSYNTAXCMO:=plugins/syntax/nat_syntax_plugin.cmo
+OTHERSYNTAXCMO:=$(addprefix plugins/syntax/, \
+        z_syntax_plugin.cmo \
+        numbers_syntax_plugin.cmo \
+        r_syntax_plugin.cmo \
+	ascii_syntax_plugin.cmo \
+        string_syntax_plugin.cmo )
+DECLMODECMO:=plugins/decl_mode/decl_mode_plugin.cmo
+DERIVECMO:=plugins/derive/derive_plugin.cmo
+SSRMATCHINGCMO:=plugins/ssrmatching/ssrmatching_plugin.cmo
+
+PLUGINSCMO:=$(OMEGACMO) $(ROMEGACMO) $(MICROMEGACMO) $(DECLMODECMO) \
+        $(QUOTECMO) $(RINGCMO) \
+        $(FOURIERCMO) $(EXTRACTIONCMO) \
+        $(CCCMO)  $(FOCMO) $(RTAUTOCMO) $(BTAUTOCMO) \
+        $(FUNINDCMO) $(NSATZCMO) $(NATSYNTAXCMO) $(OTHERSYNTAXCMO) \
+	$(DERIVECMO) $(SSRMATCHINGCMO)
+
+ifeq ($(HASNATDYNLINK)-$(BEST),false-opt)
+ STATICPLUGINS:=$(PLUGINSCMO)
+ PLUGINS:=
+else
+ STATICPLUGINS:=
+ PLUGINS:=$(PLUGINSCMO)
+endif
+PLUGINSOPT:=$(PLUGINSCMO:.cmo=.cmxs)
 
-COQMAKEFILECMO:=lib/clib.cma ide/project_file.cmo tools/coq_makefile.cmo
+LINKCMO:=$(CORECMA) $(STATICPLUGINS)
+LINKCMX:=$(CORECMA:.cma=.cmxa) $(STATICPLUGINS:.cmo=.cmx)
 
 ###########################################################################
 # vo files
@@ -272,127 +147,41 @@ COQMAKEFILECMO:=lib/clib.cma ide/project_file.cmo tools/coq_makefile.cmo
 
 ## we now retrieve the names of .vo file to compile in */vo.itarget files
 
-cat_vo_itarget = $(addprefix $(1)/,$(shell cat $(1)/vo.itarget))
-
-## Theories
-
-INITVO:=$(call cat_vo_itarget, theories/Init)
-LOGICVO:=$(call cat_vo_itarget, theories/Logic)
-STRUCTURESVO:=$(call cat_vo_itarget, theories/Structures)
-ARITHVO:=$(call cat_vo_itarget, theories/Arith)
-SORTINGVO:=$(call cat_vo_itarget, theories/Sorting)
-BOOLVO:=$(call cat_vo_itarget, theories/Bool)
-PARITHVO:=$(call cat_vo_itarget, theories/PArith)
-NARITHVO:=$(call cat_vo_itarget, theories/NArith)
-ZARITHVO:=$(call cat_vo_itarget, theories/ZArith)
-QARITHVO:=$(call cat_vo_itarget, theories/QArith)
-LISTSVO:=$(call cat_vo_itarget, theories/Lists)
-VECTORSVO:=$(call cat_vo_itarget, theories/Vectors)
-STRINGSVO:=$(call cat_vo_itarget, theories/Strings)
-SETSVO:=$(call cat_vo_itarget, theories/Sets)
-FSETSVO:=$(call cat_vo_itarget, theories/FSets)
-MSETSVO:=$(call cat_vo_itarget, theories/MSets)
-RELATIONSVO:=$(call cat_vo_itarget, theories/Relations)
-WELLFOUNDEDVO:=$(call cat_vo_itarget, theories/Wellfounded)
-REALSVO:=$(call cat_vo_itarget, theories/Reals)
-NUMBERSVO:=$(call cat_vo_itarget, theories/Numbers)
-SETOIDSVO:=$(call cat_vo_itarget, theories/Setoids)
-UNICODEVO:=$(call cat_vo_itarget, theories/Unicode)
-CLASSESVO:=$(call cat_vo_itarget, theories/Classes)
-PROGRAMVO:=$(call cat_vo_itarget, theories/Program)
-COMPATVO:=$(call cat_vo_itarget, theories/Compat)
-
-THEORIESVO:=\
-  $(INITVO) $(LOGICVO) $(ARITHVO) $(BOOLVO) \
-  $(UNICODEVO) $(CLASSESVO) $(PROGRAMVO) \
-  $(RELATIONSVO) $(WELLFOUNDEDVO) $(SETOIDSVO) \
-  $(LISTSVO) $(STRINGSVO) \
-  $(PARITHVO) $(NARITHVO) $(ZARITHVO) \
-  $(SETSVO) $(FSETSVO) $(MSETSVO) \
-  $(REALSVO)  $(SORTINGVO) $(QARITHVO) \
-  $(NUMBERSVO) $(STRUCTURESVO) $(VECTORSVO) \
-  $(COMPATVO)
-
-THEORIESLIGHTVO:= $(INITVO) $(LOGICVO) $(UNICODEVO) $(ARITHVO)
-
-## Plugins
-
-OMEGAVO:=$(call cat_vo_itarget, plugins/omega)
-ROMEGAVO:=$(call cat_vo_itarget, plugins/romega)
-MICROMEGAVO:=$(call cat_vo_itarget, plugins/micromega)
-QUOTEVO:=$(call cat_vo_itarget, plugins/quote)
-RINGVO:=$(call cat_vo_itarget, plugins/setoid_ring)
-NSATZVO:=$(call cat_vo_itarget, plugins/nsatz)
-FOURIERVO:=$(call cat_vo_itarget, plugins/fourier)
-FUNINDVO:=$(call cat_vo_itarget, plugins/funind)
-BTAUTOVO:=$(call cat_vo_itarget, plugins/btauto)
-RTAUTOVO:=$(call cat_vo_itarget, plugins/rtauto)
-EXTRACTIONVO:=$(call cat_vo_itarget, plugins/extraction)
-CCVO:=
-DERIVEVO:=$(call cat_vo_itarget, plugins/derive)
-
-PLUGINSVO:= $(OMEGAVO) $(ROMEGAVO) $(MICROMEGAVO) \
-	    $(FOURIERVO) $(CCVO) $(FUNINDVO) \
-	    $(RTAUTOVO) $(BTAUTOVO) $(RINGVO) $(QUOTEVO) \
-            $(NSATZVO) $(EXTRACTIONVO) $(DERIVEVO)
+THEORIESVO:= $(foreach f, $(wildcard theories/*/vo.itarget), \
+                $(addprefix $(dir $(f)),$(shell cat $(f))))
+
+PLUGINSVO:=  $(foreach f, $(wildcard plugins/*/vo.itarget), \
+                $(addprefix $(dir $(f)),$(shell cat $(f))))
 
 ALLVO:= $(THEORIESVO) $(PLUGINSVO)
 VFILES:= $(ALLVO:.vo=.v)
+
+## More specific targets
+
+THEORIESLIGHTVO:= \
+ $(filter theories/Init/% theories/Logic/% theories/Unicode/% theories/Arith/%, $(THEORIESVO))
+
 ALLSTDLIB := test-suite/misc/universes/all_stdlib
 
 # convert a (stdlib) filename into a module name:
 # remove .vo, replace theories and plugins by Coq, and replace slashes by dots
 vo_to_mod = $(subst /,.,$(patsubst theories/%,Coq.%,$(patsubst plugins/%,Coq.%,$(1:.vo=))))
 
+ALLMODS:=$(call vo_to_mod,$(ALLVO))
+
+
 # Converting a stdlib filename into native compiler filenames
 # Used for install targets
 vo_to_cm = $(foreach vo,$(1),$(dir $(vo)).coq-native/$(subst /,_,$(patsubst theories/%,NCoq_%,$(patsubst plugins/%,NCoq_%,$(vo:.vo=.cm*)))))
 
 vo_to_obj = $(foreach vo,$(1),$(dir $(vo)).coq-native/$(subst /,_,$(patsubst theories/%,NCoq_%,$(patsubst plugins/%,NCoq_%,$(vo:.vo=.o)))))
 
-ALLMODS:=$(call vo_to_mod,$(ALLVO))
-
 LIBFILES:=$(THEORIESVO) $(PLUGINSVO) $(call vo_to_cm,$(THEORIESVO)) \
 	    $(call vo_to_cm,$(PLUGINSVO)) $(call vo_to_obj,$(THEORIESVO)) \
 	    $(call vo_to_obj,$(PLUGINSVO)) \
 	    $(PLUGINSVO:.vo=.v) $(THEORIESVO:.vo=.v) \
 	    $(PLUGINSVO:.vo=.glob) $(THEORIESVO:.vo=.glob)
 
-LIBFILESLIGHT:=$(THEORIESLIGHTVO)
-
-###########################################################################
-# Miscellaneous
-###########################################################################
-
-MANPAGES:=man/coq-tex.1 man/coqdep.1 man/gallina.1 \
-	man/coqc.1 man/coqtop.1 man/coqtop.byte.1 man/coqtop.opt.1 \
-	man/coqwc.1 man/coqdoc.1 man/coqide.1 \
-	man/coq_makefile.1 man/coqmktop.1 man/coqchk.1
-
-###########################################################################
-# Source documentation
-###########################################################################
-
-OCAMLDOCDIR=dev/ocamldoc
-
-DOCMLIS=$(wildcard ./lib/*.mli ./intf/*.mli ./kernel/*.mli ./library/*.mli \
-	./engine/*.mli ./pretyping/*.mli ./interp/*.mli printing/*.mli \
-	./parsing/*.mli ./proofs/*.mli \
-	./tactics/*.mli ./stm/*.mli ./toplevel/*.mli ./ltac/*.mli)
-
-# Defining options to generate dependencies graphs
-DOT=dot
-ODOCDOTOPTS=-dot -dot-reduce
-
-###########################################################################
-# GTK for Coqide MacOS bundle
-###########################################################################
-
-GTKSHARE=$(shell pkg-config --variable=prefix gtk+-2.0)/share
-GTKBIN=$(shell pkg-config --variable=prefix gtk+-2.0)/bin
-GTKLIBS=$(shell pkg-config --variable=libdir gtk+-2.0)
-
-
 # For emacs: 
 # Local Variables: 
 # mode: makefile 
diff --git a/Makefile.dev b/Makefile.dev
new file mode 100644
index 000000000..8c1812da1
--- /dev/null
+++ b/Makefile.dev
@@ -0,0 +1,220 @@
+#######################################################################
+#  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       #
+#######################################################################
+
+# Extra targets for developpers :
+# debug printers, revision, partial targets ...
+
+#########################
+# Debug printers in dev/
+#########################
+
+.PHONY: devel printers
+
+DEBUGPRINTERS:=dev/top_printers.cmo dev/vm_printers.cmo
+
+devel: printers
+printers: $(CORECMA) $(DEBUGPRINTERS) dev/camlp4.dbg
+
+ifeq ($(CAMLP4),camlp5)
+dev/camlp4.dbg:
+	echo "load_printer gramlib.cma" > $@
+else
+dev/camlp4.dbg:
+	echo "load_printer camlp4lib.cma" > $@
+endif
+
+############
+# revision
+############
+
+# display the revision number when compiling a checked out source tree
+
+revision:
+	$(SHOW)'CHECK revision'
+	$(HIDE)rm -f revision.new
+ifeq ($(CHECKEDOUT),svn)
+	$(HIDE)set -e; \
+        if test -x "`which svn`"; then \
+	  export LC_ALL=C;\
+	  svn info . | sed -ne '/URL/s/.*\/\([^\/]\{1,\}\)/\1/p' > revision.new; \
+	  svn info . | sed -ne '/Revision/s/Revision: \([0-9]\{1,\}\)/\1/p'>> revision.new; \
+	fi
+endif
+ifeq ($(CHECKEDOUT),gnuarch)
+	$(HIDE)set -e; \
+        if test -x "`which tla`"; then \
+	  LANG=C; export LANG; \
+	  tla tree-version  >  revision.new ; \
+	  tla tree-revision | sed -ne 's|.*--||p' >> revision.new ; \
+	fi
+endif
+ifeq ($(CHECKEDOUT),git)
+	$(HIDE)set -e; \
+	if test -x "`which git`"; then \
+	  LANG=C; export LANG; \
+	  GIT_BRANCH=$$(git branch -a | sed -ne '/^\* /s/^\* \(.*\)/\1/p'); \
+	  GIT_HOST=$$(hostname); \
+	  GIT_PATH=$$(pwd); \
+	  (echo "$${GIT_HOST}:$${GIT_PATH},$${GIT_BRANCH}") > revision.new; \
+	  (echo "$$(git log -1 --pretty='format:%H')") >> revision.new; \
+	fi
+endif
+	$(HIDE)set -e; \
+	if test -e revision.new; then \
+          if test -e revision; then \
+	    if test "`cat revision`" = "`cat revision.new`" ; then \
+	       rm -f revision.new; \
+            else \
+               mv -f revision.new revision; \
+            fi; \
+          else \
+            mv -f revision.new revision; \
+          fi \
+	fi
+
+.PHONY: revision
+
+###################
+# Partial builds
+###################
+
+# The following partial targets are normally not necessary
+# for a complete build of coq, see instead 'make world' for that.
+# But these partial targets could be quite handy for quick builds
+# of specific components of Coq.
+
+###############################
+### 1) general-purpose targets
+###############################
+
+coqlight: theories-light tools coqbinaries
+
+states: theories/Init/Prelude.vo
+
+miniopt: $(COQTOPEXE) pluginsopt
+minibyte: $(COQTOPBYTE) pluginsbyte
+
+pluginsopt: $(PLUGINSOPT)
+pluginsbyte: $(PLUGINS)
+
+.PHONY: coqlight states miniopt minibyte pluginsopt pluginsbyte
+
+##########################
+### 2) core ML components
+##########################
+
+lib: lib/clib.cma lib/lib.cma
+kernel: kernel/kernel.cma
+byterun: $(BYTERUN)
+library: library/library.cma
+engine: engine/engine.cma
+proofs: proofs/proofs.cma
+tactics: tactics/tactics.cma
+interp: interp/interp.cma
+parsing: parsing/parsing.cma
+pretyping: pretyping/pretyping.cma
+highparsing: parsing/highparsing.cma
+stm: stm/stm.cma
+toplevel: toplevel/toplevel.cma
+ltac: ltac/ltac.cma
+
+.PHONY: lib kernel byterun library proofs tactics interp parsing pretyping
+.PHONY: engine highparsing stm toplevel ltac
+
+######################
+### 3) theories files
+######################
+
+init: $(filter theories/Init/%, $(THEORIESVO))
+logic: $(filter theories/Logic/%, $(THEORIESVO))
+arith: $(filter theories/Arith/%, $(THEORIESVO))
+bool: $(filter theories/Bool/%, $(THEORIESVO))
+parith: $(filter theories/PArith/%, $(THEORIESVO))
+narith: $(filter theories/NArith/%, $(THEORIESVO))
+zarith: $(filter theories/ZArith/%, $(THEORIESVO))
+qarith: $(filter theories/QArith/%, $(THEORIESVO))
+lists: $(filter theories/Lists/%, $(THEORIESVO))
+strings: $(filter theories/Strings/%, $(THEORIESVO))
+sets: $(filter theories/Sets/%, $(THEORIESVO))
+fsets: $(filter theories/FSets/%, $(THEORIESVO))
+relations: $(filter theories/Relations/%, $(THEORIESVO))
+wellfounded: $(filter theories/Wellfounded/%, $(THEORIESVO))
+reals: $(filter theories/Reals/%, $(THEORIESVO))
+setoids: $(filter theories/Setoids/%, $(THEORIESVO))
+sorting: $(filter theories/Sorting/%, $(THEORIESVO))
+numbers: $(filter theories/Numbers/%, $(THEORIESVO))
+unicode: $(filter theories/Unicode/%, $(THEORIESVO))
+classes: $(filter theories/Classes/%, $(THEORIESVO))
+program: $(filter theories/Program/%, $(THEORIESVO))
+structures: $(filter theories/Structures/%, $(THEORIESVO))
+vectors: $(filter theories/Vectors/%, $(THEORIESVO))
+msets: $(filter theories/MSets/%, $(THEORIESVO))
+compat: $(filter theories/Compat/%, $(THEORIESVO))
+
+theories-light: $(THEORIESLIGHTVO)
+
+noreal: unicode logic arith bool zarith qarith lists sets fsets \
+	relations wellfounded setoids sorting
+
+.PHONY: init theories-light noreal
+.PHONY: logic arith bool narith zarith qarith lists strings sets
+.PHONY: fsets relations wellfounded reals setoids sorting numbers
+.PHONY: msets mmaps compat parith classes program unicode structures vectors
+
+################
+### 4) plugins
+################
+
+OMEGAVO:=$(filter plugins/omega/%, $(PLUGINSVO))
+ROMEGAVO:=$(filter plugins/romega/%, $(PLUGINSVO))
+MICROMEGAVO:=$(filter plugins/micromega/%, $(PLUGINSVO))
+QUOTEVO:=$(filter plugins/quote/%, $(PLUGINSVO))
+RINGVO:=$(filter plugins/setoid_ring/%, $(PLUGINSVO))
+NSATZVO:=$(filter plugins/nsatz/%, $(PLUGINSVO))
+FOURIERVO:=$(filter plugins/fourier/%, $(PLUGINSVO))
+FUNINDVO:=$(filter plugins/funind/%, $(PLUGINSVO))
+BTAUTOVO:=$(filter plugins/btauto/%, $(PLUGINSVO))
+RTAUTOVO:=$(filter plugins/rtauto/%, $(PLUGINSVO))
+EXTRACTIONVO:=$(filter plugins/extraction/%, $(PLUGINSVO))
+CCVO:=
+DERIVEVO:=$(filter plugins/derive/%, $(PLUGINSVO))
+
+omega: $(OMEGAVO) $(OMEGACMO) $(ROMEGAVO) $(ROMEGACMO)
+micromega: $(MICROMEGAVO) $(MICROMEGACMO) $(CSDPCERT)
+setoid_ring: $(RINGVO) $(RINGCMO)
+nsatz: $(NSATZVO) $(NSATZCMO)
+extraction: $(EXTRACTIONCMO)
+fourier: $(FOURIERVO) $(FOURIERCMO)
+funind: $(FUNINDCMO) $(FUNINDVO)
+cc: $(CCVO) $(CCCMO)
+rtauto: $(RTAUTOVO) $(RTAUTOCMO)
+btauto: $(BTAUTOVO) $(BTAUTOCMO)
+
+.PHONY: omega micromega setoid_ring nsatz extraction
+.PHONY: fourier funind cc rtauto btauto
+
+#################################
+### Misc other development rules
+#################################
+
+# NOTA : otags only accepts camlp4 as preprocessor, so the following rule
+# won't build tags of .ml4 when compiling with camlp5
+
+otags:
+	otags $(MLIFILES) $(filter-out configure.ml, $(MLSTATICFILES)) \
+	$(if $(filter camlp5,$(CAMLP4)), , \
+          -pa op -pa g -pa m -pa rq $(addprefix -pa , $(CAMLP4DEPS)) \
+          $(addprefix -impl , $(ML4FILES)))
+
+.PHONY: otags
+
+
+# For emacs:
+# Local Variables:
+# mode: makefile
+# End:
diff --git a/Makefile.doc b/Makefile.doc
index b7251ce57..9ae20ba76 100644
--- a/Makefile.doc
+++ b/Makefile.doc
@@ -1,3 +1,11 @@
+#######################################################################
+#  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       #
+#######################################################################
+
 # Makefile for the Coq documentation
 
 # To compile documentation, you need the following tools:
@@ -5,6 +13,61 @@
 # Pdf: pdflatex
 # Html: hevea (http://hevea.inria.fr) >= 1.05
 
+# The main entry point :
+
+documentation: doc-$(WITHDOC)  ## see $(WITHDOC) in config/Makefile
+doc-all: doc
+doc-no:
+
+.PHONY: documentation doc-all doc-no
+
+######################################################################
+### Variables
+######################################################################
+
+LATEX:=latex
+BIBTEX:=BIBINPUTS=.: bibtex -min-crossrefs=10
+MAKEINDEX:=makeindex
+PDFLATEX:=pdflatex
+DVIPS:=dvips
+FIG2DEV:=fig2dev
+CONVERT:=convert
+HEVEA:=hevea
+HACHA:=hacha
+HEVEAOPTS:=-fix -exec xxdate.exe
+HEVEALIB:=/usr/local/lib/hevea:/usr/lib/hevea
+HTMLSTYLE:=simple
+export TEXINPUTS:=$(HEVEALIB):
+COQTEXOPTS:=-boot -n 72 -sl -small
+
+DOCCOMMON:=doc/common/version.tex doc/common/title.tex doc/common/macros.tex
+
+REFMANCOQTEXFILES:=$(addprefix doc/refman/, \
+  RefMan-gal.v.tex RefMan-ext.v.tex \
+  RefMan-mod.v.tex RefMan-tac.v.tex \
+  RefMan-cic.v.tex RefMan-lib.v.tex \
+  RefMan-tacex.v.tex RefMan-syn.v.tex \
+  RefMan-oth.v.tex RefMan-ltac.v.tex \
+  RefMan-decl.v.tex RefMan-pro.v.tex RefMan-sch.v.tex \
+  Cases.v.tex Coercion.v.tex CanonicalStructures.v.tex Extraction.v.tex \
+  Program.v.tex Omega.v.tex Micromega.v.tex Polynom.v.tex Nsatz.v.tex \
+  Setoid.v.tex Classes.v.tex Universes.v.tex \
+  Misc.v.tex)
+
+REFMANTEXFILES:=$(addprefix doc/refman/, \
+  headers.sty Reference-Manual.tex \
+  RefMan-pre.tex RefMan-int.tex RefMan-com.tex \
+  RefMan-uti.tex RefMan-ide.tex RefMan-add.tex RefMan-modr.tex \
+  AsyncProofs.tex ) \
+  $(REFMANCOQTEXFILES) \
+
+REFMANEPSFILES:=doc/refman/coqide.eps doc/refman/coqide-queries.eps
+
+REFMANFILES:=$(REFMANTEXFILES) $(DOCCOMMON) $(REFMANEPSFILES) doc/refman/biblio.bib
+
+REFMANPNGFILES:=$(REFMANEPSFILES:.eps=.png)
+
+
 ######################################################################
 ### General rules
 ######################################################################
@@ -61,7 +124,7 @@ endif
 	(cd `dirname $<`; $(DVIPS) -q -o `basename $@` `basename $<`)
 
 %.png: %.fig
-	$(FIG2DEV) -m 2 -L png $< $@
+	$(FIG2DEV) -L png -m 2 $< $@
 
 %.pdf: %.fig
 	$(FIG2DEV) -L pdftex $< $@
@@ -138,17 +201,17 @@ doc/refman/styles.hva: doc/common/styles/html/$(HTMLSTYLE)/styles.hva
 	$(INSTALLLIB) $< doc/refman
 
 INDEXES:= doc/refman/html/command-index.html doc/refman/html/tactic-index.html
-ALLINDEXES:= doc/refman/html/index.html $(INDEXES)
 
-$(ALLINDEXES): refman-html-dir
+refman-html-dir $(INDEXES): doc/refman/html/index.html ;
 
-refman-html-dir: doc/refman/Reference-Manual.html $(REFMANPNGFILES) \
+doc/refman/html/index.html: doc/refman/Reference-Manual.html $(REFMANPNGFILES) \
 	       doc/refman/cover.html doc/refman/styles.hva doc/refman/index.html
 	- rm -rf doc/refman/html
 	$(MKDIR) doc/refman/html
 	$(INSTALLLIB) $(REFMANPNGFILES) doc/refman/html
 	(cd doc/refman/html; $(HACHA) -nolinks -tocbis -o toc.html ../styles.hva ../Reference-Manual.html)
 	$(INSTALLLIB) doc/refman/cover.html doc/refman/html/index.html
+	@touch $(INDEXES)
 	-$(INSTALLLIB) doc/common/styles/html/$(HTMLSTYLE)/*.css doc/refman/html
 
 refman-quick:
@@ -339,6 +402,80 @@ install-doc-index-urls:
 	$(MKDIR) $(FULLDATADIR)
 	$(INSTALLLIB) $(INDEXURLS) $(FULLDATADIR)
 
+
+###########################################################################
+# Documentation of the source code (using ocamldoc)
+###########################################################################
+
+OCAMLDOCDIR=dev/ocamldoc
+
+DOCMLIS=$(wildcard ./lib/*.mli ./intf/*.mli ./kernel/*.mli ./library/*.mli \
+	./engine/*.mli ./pretyping/*.mli ./interp/*.mli printing/*.mli \
+	./parsing/*.mli ./proofs/*.mli \
+	./tactics/*.mli ./stm/*.mli ./toplevel/*.mli ./ltac/*.mli)
+
+# Defining options to generate dependencies graphs
+DOT=dot
+ODOCDOTOPTS=-dot -dot-reduce
+
+.PHONY: source-doc mli-doc ml-doc
+
+source-doc: mli-doc $(OCAMLDOCDIR)/coq.pdf
+
+$(OCAMLDOCDIR)/coq.tex: $(DOCMLIS:.mli=.cmi)
+	$(SHOW)'OCAMLDOC -latex -o $@'
+	$(HIDE)$(OCAMLFIND) ocamldoc -latex -rectypes -I $(MYCAMLP4LIB) $(MLINCLUDES)\
+	$(DOCMLIS) -noheader -t "Coq mlis documentation" \
+	-intro $(OCAMLDOCDIR)/docintro -o $@.tmp
+	$(SHOW)'OCAMLDOC utf8 fix'
+	$(HIDE)$(OCAMLDOCDIR)/fix-ocamldoc-utf8 $@.tmp
+	$(HIDE)cat $(OCAMLDOCDIR)/header.tex $@.tmp > $@
+	rm $@.tmp
+
+mli-doc: $(DOCMLIS:.mli=.cmi)
+	$(SHOW)'OCAMLDOC -html'
+	$(HIDE)$(OCAMLFIND) ocamldoc -charset utf-8 -html -rectypes -I +threads -I $(MYCAMLP4LIB) $(MLINCLUDES) \
+	$(DOCMLIS) -d $(OCAMLDOCDIR)/html -colorize-code \
+	-t "Coq mlis documentation" -intro $(OCAMLDOCDIR)/docintro \
+	-css-style style.css
+
+ml-dot: $(MLFILES)
+	$(OCAMLFIND) ocamldoc -dot -dot-reduce -rectypes -I +threads -I $(CAMLLIB) -I $(MYCAMLP4LIB) $(MLINCLUDES) \
+	$(filter $(addsuffix /%.ml,$(CORESRCDIRS)),$(MLFILES)) -o $(OCAMLDOCDIR)/coq.dot
+
+%_dep.png: %.dot
+	$(DOT) -Tpng $< -o $@
+
+%_types.dot: %.mli
+	$(OCAMLFIND) ocamldoc -rectypes $(MLINCLUDES) $(ODOCDOTOPTS) -dot-types -o $@ $<
+
+OCAMLDOC_MLLIBD = $(OCAMLFIND) ocamldoc -rectypes $(MLINCLUDES) $(ODOCDOTOPTS) -o $@ \
+  $(foreach lib,$(|:.mllib.d=_MLLIB_DEPENDENCIES),$(addsuffix .ml,$($(lib))))
+
+%.dot: | %.mllib.d
+	$(OCAMLDOC_MLLIBD)
+
+ml-doc:
+	$(OCAMLFIND) ocamldoc -charset utf-8 -html -rectypes -I +threads $(MLINCLUDES) $(COQIDEFLAGS) -d $(OCAMLDOCDIR) $(MLSTATICFILES)
+
+parsing/parsing.dot : | parsing/parsing.mllib.d parsing/highparsing.mllib.d
+	$(OCAMLDOC_MLLIBD)
+
+grammar/grammar.dot : | grammar/grammar.mllib.d
+	$(OCAMLDOC_MLLIBD)
+
+tactics/tactics.dot: | tactics/tactics.mllib.d ltac/ltac.mllib.d
+	$(OCAMLDOC_MLLIBD)
+
+%.dot: %.mli
+	$(OCAMLFIND) ocamldoc -rectypes $(MLINCLUDES) $(ODOCDOTOPTS) -o $@ $<
+
+$(OCAMLDOCDIR)/%.pdf: $(OCAMLDOCDIR)/%.tex
+	$(SHOW)'PDFLATEX $*.tex'
+	$(HIDE)(cd $(OCAMLDOCDIR) ; pdflatex -interaction=batchmode $*.tex && pdflatex -interaction=batchmode $*.tex)
+	$(HIDE)(cd doc/tools/; show_latex_messages -no-overfull ../../$(OCAMLDOCDIR)/$*.log)
+
+
 # For emacs:
 # Local Variables:
 # mode: makefile
diff --git a/Makefile.ide b/Makefile.ide
new file mode 100644
index 000000000..48a269ab7
--- /dev/null
+++ b/Makefile.ide
@@ -0,0 +1,255 @@
+#######################################################################
+#  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       #
+#######################################################################
+
+## Makefile rules for building the CoqIDE interface
+
+## NB: For the moment, the build system of CoqIDE is part of
+## the one of Coq. In particular, this Makefile.ide is included in
+## Makefile.build. Please ensure that the rules define here are
+## indeed specific to files of the form ide/*
+
+## Coqide-related variables set by ./configure in config/Makefile
+
+#COQIDEINCLUDES : something like -I +lablgtk2
+#HASCOQIDE : opt / byte / no
+#IDEFLAGS : some extra cma, for instance
+#IDEOPTCDEPS : on windows, ide/ide_win32_stubs.o ide/coq_icon.o
+#IDECDEPS
+#IDECDEPSFLAGS
+#IDEINT : X11 / QUARTZ / WIN32
+
+## CoqIDE Executable
+
+COQIDEBYTE:=bin/coqide.byte$(EXE)
+COQIDE:=bin/coqide$(EXE)
+COQIDEAPP:=bin/CoqIDE_$(VERSION).app
+COQIDEINAPP:=$(COQIDEAPP)/Contents/MacOS/coqide
+
+## CoqIDE source directory and files
+
+# Note : for just building bin/coqide, we could only consider
+# config, lib, ide and ide/utils. But the coqidetop plugin (the
+# one that will be loaded by coqtop -ideslave) refers to some
+# core modules of coq, for instance printing/*.
+
+IDESRCDIRS:= $(CORESRCDIRS) ide ide/utils
+
+COQIDEFLAGS=$(addprefix -I , $(IDESRCDIRS)) $(COQIDEINCLUDES)
+
+IDEDEPS:=lib/clib.cma lib/cErrors.cmo lib/spawn.cmo
+IDECMA:=ide/ide.cma
+IDETOPLOOPCMA=ide/coqidetop.cma
+
+LINKIDE:=$(IDEDEPS) $(IDECDEPS) $(IDECMA) ide/coqide_main.ml
+LINKIDEOPT:=$(IDEOPTCDEPS) $(patsubst %.cma,%.cmxa,$(IDEDEPS:.cmo=.cmx)) $(IDECMA:.cma=.cmxa) ide/coqide_main.ml
+
+IDEFILES=$(wildcard ide/*.lang) ide/coq_style.xml ide/coq.png ide/MacOS/default_accel_map
+
+## GTK for Coqide MacOS bundle
+
+GTKSHARE=$(shell pkg-config --variable=prefix gtk+-2.0)/share
+GTKBIN=$(shell pkg-config --variable=prefix gtk+-2.0)/bin
+GTKLIBS=$(shell pkg-config --variable=libdir gtk+-2.0)
+
+
+###########################################################################
+# CoqIde special targets
+###########################################################################
+
+.PHONY: coqide coqide-binaries coqide-no coqide-byte coqide-opt coqide-files
+.PHONY: ide-toploop
+
+# target to build CoqIde
+coqide: coqide-files coqide-binaries theories/Init/Prelude.vo
+
+coqide-binaries: coqide-$(HASCOQIDE) ide-toploop
+coqide-no:
+coqide-byte: $(COQIDEBYTE) $(COQIDE)
+coqide-opt:  $(COQIDEBYTE) $(COQIDE)
+coqide-files: $(IDEFILES)
+ifeq ($(BEST),opt)
+ide-toploop: $(IDETOPLOOPCMA) $(IDETOPLOOPCMA:.cma=.cmxs)
+else
+ide-toploop: $(IDETOPLOOPCMA)
+endif
+
+ifeq ($(HASCOQIDE),opt)
+$(COQIDE): $(LINKIDEOPT)
+	$(SHOW)'OCAMLOPT -o $@'
+	$(HIDE)$(OCAMLOPT) $(COQIDEFLAGS) $(OPTFLAGS) -o $@ unix.cmxa threads.cmxa lablgtk.cmxa \
+		lablgtksourceview2.cmxa str.cmxa $(IDEFLAGS:.cma=.cmxa) $^
+	$(STRIP) $@
+else
+$(COQIDE): $(COQIDEBYTE)
+	cp $< $@
+endif
+
+$(COQIDEBYTE): $(LINKIDE)
+	$(SHOW)'OCAMLC -o $@'
+	$(HIDE)$(OCAMLC) $(COQIDEFLAGS) $(BYTEFLAGS) -o $@ unix.cma threads.cma lablgtk.cma \
+	        lablgtksourceview2.cma str.cma $(IDEFLAGS) $(IDECDEPSFLAGS) $^
+
+ide/coqide_main.ml: ide/coqide_main.ml4 config/Makefile # no camlp4deps here
+	$(SHOW)'CAMLP4O   $<'
+	$(HIDE)$(CAMLP4O) -I $(MYCAMLP4LIB) $(PR_O) $(CAMLP4USE) -D$(IDEINT) -impl $< -o $@
+
+
+ide/%.cmi: ide/%.mli
+	$(SHOW)'OCAMLC    $<'
+	$(HIDE)$(OCAMLC) $(COQIDEFLAGS) $(BYTEFLAGS) -c $<
+
+ide/%.cmo: ide/%.ml
+	$(SHOW)'OCAMLC    $<'
+	$(HIDE)$(OCAMLC) $(COQIDEFLAGS) $(BYTEFLAGS) -c $<
+
+ide/%.cmx: ide/%.ml
+	$(SHOW)'OCAMLOPT  $<'
+	$(HIDE)$(OCAMLOPT) $(COQIDEFLAGS) $(OPTFLAGS) $(HACKMLI) -c $<
+
+
+####################
+## Install targets
+####################
+
+.PHONY: install-coqide install-ide-bin install-ide-toploop install-ide-files install-ide-info install-ide-devfiles
+
+ifeq ($(HASCOQIDE),no)
+install-coqide: install-ide-toploop
+else
+install-coqide: install-ide-bin install-ide-toploop install-ide-files install-ide-info install-ide-devfiles
+endif
+
+install-ide-bin:
+	$(MKDIR) $(FULLBINDIR)
+	$(INSTALLBIN) $(COQIDE) $(FULLBINDIR)
+
+install-ide-toploop:
+	$(MKDIR) $(FULLCOQLIB)/toploop
+	$(INSTALLBIN) $(IDETOPLOOPCMA) $(FULLCOQLIB)/toploop/
+ifeq ($(BEST),opt)
+	$(INSTALLBIN) $(IDETOPLOOPCMA:.cma=.cmxs) $(FULLCOQLIB)/toploop/
+endif
+
+install-ide-devfiles:
+	$(MKDIR) $(FULLCOQLIB)
+	$(INSTALLSH) $(FULLCOQLIB) $(IDECMA) \
+	  $(foreach lib,$(IDECMA:.cma=_MLLIB_DEPENDENCIES),$(addsuffix .cmi,$($(lib))))
+ifeq ($(BEST),opt)
+	$(INSTALLSH) $(FULLCOQLIB) $(IDECMA:.cma=.cmxa) $(IDECMA:.cma=.a)
+endif
+
+install-ide-files: #Please update $(COQIDEAPP)/Contents/Resources/ at the same time
+	$(MKDIR) $(FULLDATADIR)
+	$(INSTALLLIB) ide/coq.png ide/*.lang ide/coq_style.xml $(FULLDATADIR)
+	$(MKDIR) $(FULLCONFIGDIR)
+	if [ $(IDEINT) = QUARTZ ] ; then $(INSTALLLIB) ide/mac_default_accel_map $(FULLCONFIGDIR)/coqide.keys ; fi
+
+install-ide-info:
+	$(MKDIR) $(FULLDOCDIR)
+	$(INSTALLLIB) ide/FAQ $(FULLDOCDIR)/FAQ-CoqIde
+
+###########################################################################
+# CoqIde MacOS special targets
+###########################################################################
+
+.PHONY: $(COQIDEAPP)/Contents
+
+$(COQIDEAPP)/Contents:
+	rm -rdf $@
+	$(MKDIR) $@
+	sed -e "s/VERSION/$(VERSION4MACOS)/g" ide/MacOS/Info.plist.template > $@/Info.plist
+	$(MKDIR) "$@/MacOS"
+
+$(COQIDEINAPP): ide/macos_prehook.cmx $(LINKIDEOPT) | $(COQIDEAPP)/Contents
+	$(SHOW)'OCAMLOPT -o $@'
+	$(HIDE)$(OCAMLOPT) $(COQIDEFLAGS) $(OPTFLAGS) -o $@ \
+		unix.cmxa lablgtk.cmxa lablgtksourceview2.cmxa str.cmxa \
+		threads.cmxa $(IDEFLAGS:.cma=.cmxa) $^
+	$(STRIP) $@
+
+$(COQIDEAPP)/Contents/Resources/share: $(COQIDEAPP)/Contents
+	$(MKDIR) $@/coq/
+	$(INSTALLLIB) ide/coq.png ide/*.lang ide/coq_style.xml $@/coq/
+	$(MKDIR) $@/gtksourceview-2.0/{language-specs,styles}
+	$(INSTALLLIB) "$(GTKSHARE)/"gtksourceview-2.0/language-specs/{def.lang,language2.rng} $@/gtksourceview-2.0/language-specs/
+	$(INSTALLLIB) "$(GTKSHARE)/"gtksourceview-2.0/styles/{styles.rng,classic.xml} $@/gtksourceview-2.0/styles/
+	cp -R "$(GTKSHARE)/"locale $@
+	cp -R "$(GTKSHARE)/"icons $@
+	cp -R "$(GTKSHARE)/"themes $@
+
+$(COQIDEAPP)/Contents/Resources/loaders: $(COQIDEAPP)/Contents
+	$(MKDIR) $@
+	$(INSTALLLIB) $$("$(GTKBIN)/gdk-pixbuf-query-loaders" | sed -n -e '5 s!.*= \(.*\)$$!\1!p')/libpixbufloader-png.so $@
+
+$(COQIDEAPP)/Contents/Resources/immodules: $(COQIDEAPP)/Contents
+	$(MKDIR) $@
+	$(INSTALLLIB) "$(GTKLIBS)/gtk-2.0/2.10.0/immodules/"*.so $@
+
+
+$(COQIDEAPP)/Contents/Resources/etc: $(COQIDEAPP)/Contents/Resources/lib
+	$(MKDIR) $@/xdg/coq
+	$(INSTALLLIB) ide/MacOS/default_accel_map $@/xdg/coq/coqide.keys
+	$(MKDIR) $@/gtk-2.0
+	{ "$(GTKBIN)/gdk-pixbuf-query-loaders" $@/../loaders/*.so |\
+	 sed -e "s!/.*\(/loaders/.*.so\)!@executable_path/../Resources/\1!"; } \
+	> $@/gtk-2.0/gdk-pixbuf.loaders
+	{ "$(GTKBIN)/gtk-query-immodules-2.0" $@/../immodules/*.so |\
+	 sed -e "s!/.*\(/immodules/.*.so\)!@executable_path/../Resources/\1!" |\
+	 sed -e "s!/.*\(/share/locale\)!@executable_path/../Resources/\1!"; } \
+	> $@/gtk-2.0/gtk-immodules.loaders
+	$(MKDIR) $@/pango
+	echo "[Pango]" > $@/pango/pangorc
+
+$(COQIDEAPP)/Contents/Resources/lib: $(COQIDEAPP)/Contents/Resources/immodules $(COQIDEAPP)/Contents/Resources/loaders $(COQIDEAPP)/Contents $(COQIDEINAPP)
+	$(MKDIR) $@
+	$(INSTALLLIB) $(GTKLIBS)/charset.alias $@/
+	$(MKDIR) $@/pango/1.8.0/modules
+	$(INSTALLLIB) "$(GTKLIBS)/pango/1.8.0/modules/"*.so $@/pango/1.8.0/modules/
+	{ "$(GTKBIN)/pango-querymodules" $@/pango/1.8.0/modules/*.so |\
+	 sed -e "s!/.*\(/pango/1.8.0/modules/.*.so\)!@executable_path/../Resources/lib\1!"; } \
+	> $@/pango/1.8.0/modules.cache
+
+	for i in $$(otool -L $(COQIDEINAPP) |sed -n -e "\@$(GTKLIBS)@ s/[^/]*\(\/[^ ]*\) .*$$/\1/p"); \
+	    do cp $$i $@/; \
+	    ide/MacOS/relatify_with-respect-to_.sh $@/$$(basename $$i) $(GTKLIBS) $@; \
+	done
+	for i in $@/../loaders/*.so $@/../immodules/*.so $@/pango/1.8.0/modules/*.so; \
+	    do \
+		for j in $$(otool -L $$i | sed -n -e "\@$(GTKLIBS)@ s/[^/]*\(\/[^ ]*\) .*$$/\1/p"); \
+		do cp $$j $@/; ide/MacOS/relatify_with-respect-to_.sh $@/$$(basename $$j) $(GTKLIBS) $@; done; \
+		ide/MacOS/relatify_with-respect-to_.sh $$i $(GTKLIBS) $@; \
+	    done
+	EXTRAWORK=1; \
+	while [ $${EXTRAWORK} -eq 1 ]; \
+	do EXTRAWORK=0; \
+	    for i in $@/*.dylib; \
+	    do for j in $$(otool -L $$i | sed -n -e "\@$(GTKLIBS)@ s/[^/]*\(\/[^ ]*\) .*$$/\1/p"); \
+		do EXTRAWORK=1; cp $$j $@/; ide/MacOS/relatify_with-respect-to_.sh $@/$$(basename $$j) $(GTKLIBS) $@; done; \
+	    done; \
+	done
+	ide/MacOS/relatify_with-respect-to_.sh $(COQIDEINAPP) $(GTKLIBS) $@
+
+$(COQIDEAPP)/Contents/Resources:$(COQIDEAPP)/Contents/Resources/etc $(COQIDEAPP)/Contents/Resources/share
+	$(INSTALLLIB) ide/MacOS/*.icns $@
+
+$(COQIDEAPP):$(COQIDEAPP)/Contents/Resources
+	$(CODESIGN) $@
+
+###########################################################################
+# CoqIde for Windows special targets
+###########################################################################
+
+%.o: %.rc
+	$(SHOW)'WINDRES    $<'
+	$(HIDE)i686-w64-mingw32-windres -i $< -o $@
+
+
+# For emacs:
+# Local Variables:
+# mode: makefile
+# End:
diff --git a/Makefile.install b/Makefile.install
new file mode 100644
index 000000000..4800ea0b9
--- /dev/null
+++ b/Makefile.install
@@ -0,0 +1,150 @@
+#######################################################################
+#  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       #
+#######################################################################
+
+# This makefile regroups installation rules
+# It is included by Makefile.build
+
+# NOTA: currently, the install rules below assume that everything needed
+# has already been correctly built. In particular, this is *not* enforced
+# by dependencies between rules, so do *not* try overly clever things like
+# 'make world install' in one unique command
+
+ifeq ($(LOCAL),true)
+install:
+	@echo "Nothing to install in a local build!"
+else
+install: install-coq install-coqide install-doc-$(WITHDOC) install-meta
+endif
+
+# NOTA: for install-coqide, see Makefile.ide
+
+install-doc-all: install-doc
+install-doc-no:
+
+.PHONY: install install-doc-all install-doc-no
+
+#These variables are intended to be set by the caller to make
+#COQINSTALLPREFIX=
+#OLDROOT=
+
+  # Can be changed for a local installation (to make packages).
+  # You must NOT put a "/" at the end (Cygnus for win32 does not like "//").
+
+ifdef COQINSTALLPREFIX
+FULLBINDIR=$(BINDIR:"$(OLDROOT)%="$(COQINSTALLPREFIX)%)
+FULLCOQLIB=$(COQLIBINSTALL:"$(OLDROOT)%="$(COQINSTALLPREFIX)%)
+FULLCONFIGDIR=$(CONFIGDIR:"$(OLDROOT)%="$(COQINSTALLPREFIX)%)
+FULLDATADIR=$(DATADIR:"$(OLDROOT)%="$(COQINSTALLPREFIX)%)
+FULLMANDIR=$(MANDIR:"$(OLDROOT)%="$(COQINSTALLPREFIX)%)
+FULLEMACSLIB=$(EMACSLIB:"$(OLDROOT)%="$(COQINSTALLPREFIX)%)
+FULLCOQDOCDIR=$(COQDOCDIR:"$(OLDROOT)%="$(COQINSTALLPREFIX)%)
+FULLDOCDIR=$(DOCDIR:"$(OLDROOT)%="$(COQINSTALLPREFIX)%)
+else
+FULLBINDIR=$(BINDIR)
+FULLCOQLIB=$(COQLIBINSTALL)
+FULLCONFIGDIR=$(CONFIGDIR)
+FULLDATADIR=$(DATADIR)
+FULLMANDIR=$(MANDIR)
+FULLEMACSLIB=$(EMACSLIB)
+FULLCOQDOCDIR=$(COQDOCDIR)
+FULLDOCDIR=$(DOCDIR)
+endif
+
+.PHONY: install-coq install-binaries install-byte install-opt
+.PHONY: install-tools install-library install-devfiles
+.PHONY: install-coq-info install-coq-manpages install-emacs install-latex
+.PHONY: install-meta
+
+install-coq: install-binaries install-library install-coq-info install-devfiles
+
+install-binaries: install-tools
+	$(MKDIR) $(FULLBINDIR)
+	$(INSTALLBIN) $(COQC) $(COQTOPBYTE) $(COQTOPEXE) $(CHICKEN) $(FULLBINDIR)
+	$(MKDIR) $(FULLCOQLIB)/toploop
+	$(INSTALLBIN) $(TOPLOOPCMA) $(FULLCOQLIB)/toploop/
+ifeq ($(BEST),opt)
+	$(INSTALLBIN) $(TOPLOOPCMA:.cma=.cmxs) $(FULLCOQLIB)/toploop/
+endif
+
+
+install-tools:
+	$(MKDIR) $(FULLBINDIR)
+	# recopie des fichiers de style pour coqide
+	$(MKDIR) $(FULLCOQLIB)/tools/coqdoc
+	touch $(FULLCOQLIB)/tools/coqdoc/coqdoc.sty $(FULLCOQLIB)/tools/coqdoc/coqdoc.css # to have the mode according to umask (bug #1715)
+	$(INSTALLLIB) tools/coqdoc/coqdoc.css tools/coqdoc/coqdoc.sty $(FULLCOQLIB)/tools/coqdoc
+	$(INSTALLBIN) $(TOOLS) $(FULLBINDIR)
+
+# The list of .cmi to install, including in particular
+# - the ones obtained from .mli without .ml
+# - the ones of modules in core cma's
+# - the ones corresponding to packed plugins
+
+INSTALLCMI = $(sort \
+	$(filter-out checker/% ide/% tools/%, $(MLIFILES:.mli=.cmi)) \
+	$(foreach lib,$(CORECMA), $(addsuffix .cmi,$($(lib:.cma=_MLLIB_DEPENDENCIES))))) \
+	$(PLUGINS:.cmo=.cmi)
+
+install-devfiles:
+	$(MKDIR) $(FULLBINDIR)
+	$(INSTALLBIN) $(COQMKTOP) $(FULLBINDIR)
+	$(MKDIR) $(FULLCOQLIB)
+	$(INSTALLSH)  $(FULLCOQLIB) $(LINKCMO) $(GRAMMARCMA)
+	$(INSTALLSH)  $(FULLCOQLIB) $(INSTALLCMI)
+ifeq ($(BEST),opt)
+	$(INSTALLSH)  $(FULLCOQLIB) $(LINKCMX) $(CORECMA:.cma=.a) $(STATICPLUGINS:.cma=.a)
+endif
+
+install-library:
+	$(MKDIR) $(FULLCOQLIB)
+	$(INSTALLSH) $(FULLCOQLIB) $(LIBFILES) $(PLUGINS)
+	$(MKDIR) $(FULLCOQLIB)/user-contrib
+ifndef CUSTOM
+	$(INSTALLLIB) $(DLLCOQRUN) $(FULLCOQLIB)
+endif
+ifeq ($(BEST),opt)
+	$(INSTALLLIB) $(LIBCOQRUN) $(FULLCOQLIB)
+	$(INSTALLSH) $(FULLCOQLIB) $(PLUGINSOPT)
+endif
+# csdpcert is not meant to be directly called by the user; we install
+# it with libraries
+	-$(MKDIR) $(FULLCOQLIB)/plugins/micromega
+	$(INSTALLBIN) $(CSDPCERT) $(FULLCOQLIB)/plugins/micromega
+	rm -f $(FULLCOQLIB)/revision
+	-$(INSTALLLIB) revision $(FULLCOQLIB)
+
+install-coq-info: install-coq-manpages install-emacs install-latex
+
+MANPAGES:=man/coq-tex.1 man/coqdep.1 man/gallina.1 \
+	man/coqc.1 man/coqtop.1 man/coqtop.byte.1 man/coqtop.opt.1 \
+	man/coqwc.1 man/coqdoc.1 man/coqide.1 \
+	man/coq_makefile.1 man/coqmktop.1 man/coqchk.1
+
+install-coq-manpages:
+	$(MKDIR) $(FULLMANDIR)/man1
+	$(INSTALLLIB) $(MANPAGES) $(FULLMANDIR)/man1
+
+install-emacs:
+	$(MKDIR) $(FULLEMACSLIB)
+	$(INSTALLLIB) tools/gallina-db.el tools/coq-font-lock.el tools/gallina-syntax.el tools/gallina.el tools/coq-inferior.el $(FULLEMACSLIB)
+
+# command to update TeX' kpathsea database
+#UPDATETEX = $(MKTEXLSR) /usr/share/texmf /var/spool/texmf $(BASETEXDIR) > /dev/null
+
+install-latex:
+	$(MKDIR) $(FULLCOQDOCDIR)
+	$(INSTALLLIB) tools/coqdoc/coqdoc.sty $(FULLCOQDOCDIR)
+#	-$(UPDATETEX)
+
+install-meta: META.coq
+	$(INSTALLLIB) META.coq $(FULLCOQLIB)/META
+
+# For emacs:
+# Local Variables:
+# mode: makefile
+# End:
diff --git a/README.ci b/README.ci
new file mode 100644
index 000000000..dcf93cf00
--- /dev/null
+++ b/README.ci
@@ -0,0 +1,77 @@
+**WARNING:** This document is a work in progress and intended as a RFC.
+If you are not a Coq Developer, don't follow this instructions yet.
+
+Introduction
+============
+
+The Coq Travis CI infrastructure is meant to provide lightweight
+automatics testing of pull requests.
+
+More comprehensive testing is the responsability of Coq's [Jenkins CI
+server](https://ci.inria.fr/coq/) see, [XXX: add document] for
+instructions on how to add your development to Jenkins.
+
+How to submit your development for Coq Travis CI
+================================================
+
+Travis CI provides a convenient way to perform testing of Coq changes
+versus a set of curated libraries.
+
+Are you an author of a Coq library who would be interested in having
+the latest Coq changes validated against your development?
+
+If so, keep reading! Getting Coq changes tested against your library
+is easy, all that you need to do is:
+
+1.- Put you development in a public repository tracking coq trunk.
+2.- Make sure that your development builds in less than 35 minutes.
+3.- Submit a PR adding you development.
+4.- ?
+5.- Profit! Your library is now part of Coq's continous integration!
+
+Note that by partipating in this program, you assume a reasonable
+compromise to discuss and eventually integrate compatibility changes
+upstream.
+
+Get in touch with us to discuss any special need your development may
+have.
+
+Maintaining your contribution manually [current method]
+======================================
+
+To add your contribution to the Coq Travis CI set, add a script for
+building your library to `dev/ci/`, update `.travis.yml` and
+`Makefile.ci`. Then, submit a PR.
+
+Maintaining your contribution as an OPAM package [work in progress] [to be implemented]
+================================================
+
+You can also provide an opam package for your contribution XXX at
+https://github.com/coq/opam-coq-archive
+
+Then, add a `ci-opam-XXX` target to the `.travis.yml` file, the
+package XXX.dev will be tested against each Coq commit and pull
+request.
+
+- TODO: The main question here is what to do with `.opam` caching. We
+  could disable it altogether, however this will have an impact. We
+  could install a dummy Coq package, but `coq-*` dependencies will be
+  botched too. Need to think more.
+
+PR Overlays [work in progress] [to be implemented]
+===========
+
+It is common for PR to break some of the external tests. To this
+purpose, we provide a method for particular PR to overlay the
+repositories of some of the tests so they can provide fixed
+developments.
+
+The general idea is that the PR author will drop a file
+`dev/ci/overlays/$branch.overlay` where branch name is taken from
+`${TRAVIS_PULL_REQUEST_BRANCH:-$TRAVIS_BRANCH}`
+that is to say, the name of the original branch for the PR.
+
+The `.overlay` file will contain a set of variables that will be used
+to do the corresponding `opam pin` or to overload the corresponding
+git repositories, etc...
+
diff --git a/README.win b/README.win
deleted file mode 100644
index 8302a707f..000000000
--- a/README.win
+++ /dev/null
@@ -1,44 +0,0 @@
-THE COQ V8 SYSTEM
-=================
-
-    This file contains remarks specific to the windows port of Coq.
-
-INSTALLATION.
-=============
-
-    The Coq package for Windows comes with an auto-installer. It will
-install Coq binaries and libraries under any directory you specify
-(C:\Coq is the default path). It also creates shortcuts
-in the Windows menus.  Binaries, like coqc.exe,
-are in the bin sub-directory of the installation
-(C:\Coq\bin by default).
-
-COMPILATION.
-============
-
-    If you want to install coq, you had better transfer the precompiled
-    distribution. If you really need to recompile under Windows, here
-    are some indications:
-
-    1- Install cygwin and the wget package
-       See: http://cygwin.com
-
-    2- Download and unzip in C:\ the SDK for windows
-       See: https://coq.inria.fr/distrib/current/files/
-
-    3- From the cygwin prompt type
-
-        . /cygdrive/c/CoqSDK-85-1/environ
-
-       The first time the script installs the C toolchain.
-
-    4- Then Coq can be compiled as follows:
- 
-        ./configure -local
-        make
-
-    5- To build the installer, type:
-
-        dev/make-installer-win32.sh
-
-    The Coq Team.
diff --git a/_tags b/_tags
deleted file mode 100644
index e8317d614..000000000
--- a/_tags
+++ /dev/null
@@ -1,77 +0,0 @@
-
-## tags for binaries
-
-<tools/coqmktop.{native,byte}> : use_str, use_unix
-<tools/coqc.{native,byte}> : use_str, use_unix
-<tools/coqdep_boot.{native,byte}> : use_unix
-<tools/coqdep.{native,byte}> : use_str, use_unix
-<tools/coq_tex.{native,byte}> : use_str
-<tools/coq_makefile.{native,byte}> : use_str, use_unix
-<tools/coqdoc/main.{native,byte}> : use_str
-<ide/coqide_main.{native,byte}> : use_str, use_unix, ide
-<checker/main.{native,byte}> : use_str, use_unix, thread
-<plugins/micromega/csdpcert.{native,byte}> : use_nums, use_unix
-<tools/mkwinapp.{native,byte}> : use_unix
-<tools/fake_ide.{native,byte}> : use_unix, use_str
-
-## tags for ide
-
-<ide/**/*.{ml,mli}>: ide
-
-## tags for grammar.cm*
-
-<grammar/grammar.{cma,cmxa}> : use_unix
-
-## tags for camlp4 files 
-
-"parsing/g_constr.ml4": use_compat5
-"parsing/g_ltac.ml4": use_compat5
-"parsing/g_prim.ml4": use_compat5
-"parsing/g_proofs.ml4": use_compat5
-"parsing/g_tactic.ml4": use_compat5
-"parsing/g_vernac.ml4": use_compat5
-"parsing/g_xml.ml4": use_compat5
-"parsing/pcoq.ml4": use_compat5
-"parsing/g_obligations.ml4": use_grammar
-
-"grammar/argextend.ml4": use_compat5b
-"grammar/q_constr.ml4": use_compat5b
-"grammar/tacextend.ml4": use_compat5b
-"grammar/vernacextend.ml4": use_compat5b
-
-<tactics/*.ml4>: use_grammar
-"tactics/hipattern.ml4": use_constr
-
-<plugins/**/*.ml4>: use_grammar
-"plugins/decl_mode/g_decl_mode.ml4": use_compat5
-"plugins/funind/g_indfun.ml4": use_compat5
-
-## sub-directory inclusion
-
-# Note: "checker" is deliberately not included
-# Note: same for "config" (we create a special coq_config.ml)
-
-"parsing": include
-"ide": include
-"ide/utils": include
-"interp": include
-"intf": include
-"grammar": include
-"kernel": include
-"kernel/byterun": include
-"lib": include
-"library": include
-"parsing": include
-"plugins": include
-"engine": include
-"pretyping": include
-"printing": include
-"proofs": include
-"stm": include
-"tactics": include
-"theories": include
-"tools": include
-"tools/coqdoc": include
-"toplevel": include
-
-<plugins/**>: include
diff --git a/build b/build
deleted file mode 100755
index debf29cf4..000000000
--- a/build
+++ /dev/null
@@ -1,32 +0,0 @@
-#!/bin/sh
-
-FLAGS="-j 2"
-OCAMLBUILD=ocamlbuild
-MYCFG=myocamlbuild_config.ml
-
-export CAML_LD_LIBRARY_PATH=`pwd`/_build/kernel/byterun
-
-check_config() {
- if [ ! -f $MYCFG ]; then echo "please run ./configure first"; exit 1; fi
-}
-
-ocb() { $OCAMLBUILD $FLAGS $*; }
-
-rule() {
-  check_config
-  case $1 in
-    clean)  ocb -clean && rm -rf bin/*;;
-    all)    ocb coq.otarget;;
-    win32)  ocb coq-win32.otarget;;
-    *)      ocb $1;;
-  esac;
-}
-
-if [ $# -eq 0 ]; then
-  rule all
-else
-  while [ $# -gt 0 ]; do
-    rule $1;
-    shift
-  done
-fi
diff --git a/checker/Makefile b/checker/Makefile
deleted file mode 100644
index 2bcc9d365..000000000
--- a/checker/Makefile
+++ /dev/null
@@ -1,88 +0,0 @@
-OCAMLC=ocamlc
-OCAMLOPT=ocamlopt
-
-COQSRC=..
-
-MLDIRS=-I $(COQSRC)/config -I $(COQSRC)/lib -I $(COQSRC)/kernel -I +camlp4
-BYTEFLAGS=$(MLDIRS)
-OPTFLAGS=$(MLDIRS)
-
-CHECKERNAME=coqchk
-
-BINARIES=../bin/$(CHECKERNAME)$(EXE) ../bin/$(CHECKERNAME).opt$(EXE)
-MCHECKERLOCAL :=\
-  declarations.cmo environ.cmo \
-  closure.cmo reduction.cmo \
-  type_errors.cmo \
-  modops.cmo \
-  inductive.cmo typeops.cmo \
-  indtypes.cmo subtyping.cmo mod_checking.cmo \
-validate.cmo \
-  safe_typing.cmo check.cmo \
-  check_stat.cmo checker.cmo
-
-MCHECKER:=\
-  $(COQSRC)/config/coq_config.cmo \
-  $(COQSRC)/lib/pp_control.cmo $(COQSRC)/lib/pp.cmo $(COQSRC)/lib/compat.cmo \
-  $(COQSRC)/lib/util.cmo $(COQSRC)/lib/option.cmo $(COQSRC)/lib/hashcons.cmo \
-  $(COQSRC)/lib/system.cmo $(COQSRC)/lib/flags.cmo \
-  $(COQSRC)/lib/predicate.cmo $(COQSRC)/lib/rtree.cmo \
-  $(COQSRC)/kernel/names.cmo $(COQSRC)/kernel/univ.cmo \
-  $(COQSRC)/kernel/esubst.cmo term.cmo \
-  $(MCHECKERLOCAL)
-
-all: $(BINARIES)
-
-byte : ../bin/$(CHECKERNAME)$(EXE)
-opt : ../bin/$(CHECKERNAME).opt$(EXE)
-
-check.cma: $(MCHECKERLOCAL)
-	ocamlc $(BYTEFLAGS) -a -o $@ $(MCHECKER)
-
-check.cmxa: $(MCHECKERLOCAL:.cmo=.cmx)
-	ocamlopt $(OPTFLAGS) -a -o $@ $(MCHECKER:.cmo=.cmx)
-
-../bin/$(CHECKERNAME)$(EXE): check.cma
-	ocamlc $(BYTEFLAGS) -o $@ unix.cma gramlib.cma check.cma main.ml
-
-../bin/$(CHECKERNAME).opt$(EXE): check.cmxa
-	ocamlopt $(OPTFLAGS) -o $@ unix.cmxa gramlib.cmxa check.cmxa main.ml
-
-stats:
-	@echo STRUCTURE
-	@wc names.ml term.ml declarations.ml environ.ml type_errors.ml
-	@echo
-	@echo REDUCTION
-	@-wc esubst.ml closure.ml reduction.ml
-	@echo
-	@echo TYPAGE
-	@wc univ.ml inductive.ml indtypes.ml typeops.ml safe_typing.ml
-	@echo
-	@echo MODULES
-	@wc modops.ml subtyping.ml
-	@echo
-	@echo INTERFACE
-	@wc check*.ml main.ml 
-	@echo
-	@echo TOTAL
-	@wc *.ml | tail -1
-
-.SUFFIXES:.ml .mli .cmi .cmo .cmx
-
-.ml.cmo:
-	$(OCAMLC) -c $(BYTEFLAGS) $<
-
-.ml.cmx:
-	$(OCAMLOPT) -c $(OPTFLAGS) $<
-
-.mli.cmi:
-	$(OCAMLC) -c $(BYTEFLAGS) $<
-
-
-depend::
-	ocamldep *.ml* > .depend
-
-clean::
-	rm -f *.cm* *.o *.a *~ $(BINARIES)
-
--include .depend
diff --git a/checker/check.ml b/checker/check.ml
index 93eb2a0d2..11678fa6b 100644
--- a/checker/check.ml
+++ b/checker/check.ml
@@ -7,10 +7,12 @@
 (************************************************************************)
 
 open Pp
-open Errors
+open CErrors
 open Util
 open Names
 
+let chk_pp = Pp.pp_with Format.std_formatter
+
 let pr_dirpath dp = str (DirPath.to_string dp)
 let default_root_prefix = DirPath.empty
 let split_dirpath d =
@@ -118,7 +120,6 @@ let check_one_lib admit (dir,m) =
     (Flags.if_verbose Feedback.msg_notice
       (str "Checking library: " ++ pr_dirpath dir);
       Safe_typing.import file md m.library_extra_univs dig);
-  Flags.if_verbose Feedback.msg_notice (fnl());
   register_loaded_library m
 
 (*************************************************************************)
@@ -247,12 +248,12 @@ let locate_qualified_library qid =
 
 let error_unmapped_dir qid =
   let prefix = qid.dirpath in
-  errorlabstrm "load_absolute_library_from"
+  user_err ~hdr:"load_absolute_library_from"
     (str "Cannot load " ++ pr_path qid ++ str ":" ++ spc () ++
      str "no physical path bound to" ++ spc () ++ pr_dirlist prefix ++ fnl ())
 
 let error_lib_not_found qid =
-  errorlabstrm "load_absolute_library_from"
+  user_err ~hdr:"load_absolute_library_from"
     (str"Cannot find library " ++ pr_path qid ++ str" in loadpath")
 
 let try_locate_absolute_library dir =
@@ -298,12 +299,12 @@ let name_clash_message dir mdir f =
 let depgraph = ref LibraryMap.empty
 
 let intern_from_file (dir, f) =
-  Flags.if_verbose Feedback.msg_notice(str"[intern "++str f++str" ...");
+  Flags.if_verbose chk_pp (str"[intern "++str f++str" ...");
   let (sd,md,table,opaque_csts,digest) =
     try
       let ch = System.with_magic_number_check raw_intern_library f in
       let (sd:Cic.summary_disk), _, digest = System.marshal_in_segment f ch in
-      let (md:Cic.library_disk), _, _ = System.marshal_in_segment f ch in
+      let (md:Cic.library_disk), _, digest = System.marshal_in_segment f ch in
       let (opaque_csts:'a option), _, udg = System.marshal_in_segment f ch in
       let (discharging:'a option), _, _ = System.marshal_in_segment f ch in
       let (tasks:'a option), _, _ = System.marshal_in_segment f ch in
@@ -313,18 +314,18 @@ let intern_from_file (dir, f) =
       let () = close_in ch in
       let ch = open_in_bin f in
       if not (String.equal (Digest.channel ch pos) checksum) then
-        errorlabstrm "intern_from_file" (str "Checksum mismatch");
+        user_err ~hdr:"intern_from_file" (str "Checksum mismatch");
       let () = close_in ch in
       if dir <> sd.md_name then
-        errorlabstrm "intern_from_file"
+        user_err ~hdr:"intern_from_file"
           (name_clash_message dir sd.md_name f);
       if tasks <> None || discharging <> None then
-        errorlabstrm "intern_from_file"
+        user_err ~hdr:"intern_from_file"
           (str "The file "++str f++str " contains unfinished tasks");
       if opaque_csts <> None then begin
-       Feedback.msg_notice(str " (was a vio file) ");
+       chk_pp (str " (was a vio file) ");
       Option.iter (fun (_,_,b) -> if not b then
-        errorlabstrm "intern_from_file"
+        user_err ~hdr:"intern_from_file"
           (str "The file "++str f++str " is still a .vio"))
         opaque_csts;
       Validate.validate !Flags.debug Values.v_univopaques opaque_csts;
@@ -333,12 +334,12 @@ let intern_from_file (dir, f) =
       Validate.validate !Flags.debug Values.v_libsum sd;
       Validate.validate !Flags.debug Values.v_lib md;
       Validate.validate !Flags.debug Values.v_opaques table;
-      Flags.if_verbose Feedback.msg_notice (str" done]");
+      Flags.if_verbose chk_pp (str" done]" ++ fnl ());
       let digest =
         if opaque_csts <> None then Cic.Dviovo (digest,udg)
         else (Cic.Dvo digest) in
       sd,md,table,opaque_csts,digest
-    with e -> Flags.if_verbose Feedback.msg_notice (str" failed!]"); raise e in
+    with e -> Flags.if_verbose chk_pp (str" failed!]" ++ fnl ()); raise e in
   depgraph := LibraryMap.add sd.md_name sd.md_deps !depgraph;
   opaque_tables := LibraryMap.add sd.md_name table !opaque_tables;
   Option.iter (fun (opaque_csts,_,_) ->
diff --git a/checker/check.mllib b/checker/check.mllib
index 2fa4d5797..488507a13 100644
--- a/checker/check.mllib
+++ b/checker/check.mllib
@@ -34,7 +34,8 @@ Feedback
 Segmenttree
 Unicodetable
 Unicode
-Errors
+CErrors
+CWarnings
 CEphemeron
 Future
 CUnix
diff --git a/checker/check_stat.ml b/checker/check_stat.ml
index a26c93a30..741f53284 100644
--- a/checker/check_stat.ml
+++ b/checker/check_stat.ml
@@ -18,21 +18,16 @@ let print_memory_stat () =
   if !memory_stat then begin
     Format.printf "total heap size = %d kbytes\n" (CObj.heap_size_kb ());
     Format.print_newline();
-    flush_all()
+    Format.print_flush()
   end
 
 let output_context = ref false
 
-let pr_engagement (impr_set,type_in_type) =
+let pr_engagement impr_set =
   begin
     match impr_set with
     | ImpredicativeSet -> str "Theory: Set is impredicative"
     | PredicativeSet -> str "Theory: Set is predicative"
-  end ++ fnl() ++
-  begin
-    match type_in_type with
-    | StratifiedType -> str "Theory: Stratified type hierarchy"
-    | TypeInType -> str "Theory: Type is of type Type"
   end
 
 let cst_filter f csts =
@@ -62,8 +57,7 @@ let print_context env =
       (fnl() ++ str"CONTEXT SUMMARY" ++ fnl() ++
       str"===============" ++ fnl() ++ fnl() ++
       str "* " ++ hov 0 (pr_engagement engt ++ fnl()) ++ fnl() ++
-      str "* " ++ hov 0 (pr_ax csts) ++
-       fnl()));
+      str "* " ++ hov 0 (pr_ax csts)));
   end
 
 let stats () =
diff --git a/checker/checker.ml b/checker/checker.ml
index 61b13c60b..95a9ea78b 100644
--- a/checker/checker.ml
+++ b/checker/checker.ml
@@ -7,7 +7,7 @@
 (************************************************************************)
 
 open Pp
-open Errors
+open CErrors
 open Util
 open System
 open Flags
@@ -16,6 +16,8 @@ open Check
 
 let () = at_exit flush_all
 
+let chk_pp = Pp.pp_with Format.std_formatter
+
 let fatal_error info anomaly =
   flush_all (); Feedback.msg_error info; flush_all ();
   exit (if anomaly then 129 else 1)
@@ -71,7 +73,7 @@ let add_path ~unix_path:dir ~coq_root:coq_dirpath =
 
 let convert_string d =
   try Id.of_string d
-  with Errors.UserError _ ->
+  with CErrors.UserError _ ->
     if_verbose Feedback.msg_warning
       (str "Directory " ++ str d ++ str " cannot be used as a Coq identifier (skipped)");
     raise Exit
@@ -140,9 +142,7 @@ let set_debug () = Flags.debug := true
 
 let impredicative_set = ref Cic.PredicativeSet
 let set_impredicative_set () = impredicative_set := Cic.ImpredicativeSet
-let type_in_type = ref Cic.StratifiedType
-let set_type_in_type () = type_in_type := Cic.TypeInType
-let engage () = Safe_typing.set_engagement (!impredicative_set,!type_in_type)
+let engage () = Safe_typing.set_engagement (!impredicative_set)
 
 
 let admit_list = ref ([] : section_path list)
@@ -179,10 +179,7 @@ let print_usage_channel co command =
   output_string co command;
   output_string co "coqchk options are:\n";
   output_string co
-"  -I dir -as coqdir      map physical dir to logical coqdir\
-\n  -I dir                 map directory dir to the empty logical path\
-\n  -include dir           (idem)\
-\n  -R dir coqdir          recursively map physical dir to logical coqdir\
+"  -R dir coqdir          map physical dir to logical coqdir\
 \n\
 \n  -admit module          load module and dependencies without checking\
 \n  -norec module          check module but admit dependencies without checking\
@@ -195,7 +192,6 @@ let print_usage_channel co command =
 \n  -silent                disable trace of constants being checked\
 \n\
 \n  -impredicative-set     set sort Set impredicative\
-\n  -type-in-type          collapse type hierarchy\
 \n\
 \n  -h, --help             print this list of options\
 \n"
@@ -215,11 +211,14 @@ let usage () =
 open Type_errors
 
 let anomaly_string () = str "Anomaly: "
-let report () = (str "." ++ spc () ++ str "Please report.")
+let report () = (str "." ++ spc () ++ str "Please report" ++
+                 strbrk "at " ++ str Coq_config.wwwbugtracker ++ str ".")
 
 let guill s = str "\"" ++ str s ++ str "\""
 
-let where s =
+let where = function
+| None -> mt ()
+| Some s ->
   if !Flags.debug then  (str"in " ++ str s ++ str":" ++ spc ()) else (mt ())
 
 let rec explain_exn = function
@@ -288,7 +287,8 @@ let rec explain_exn = function
           Format.printf "@\nis not convertible with@\n";
           Print.print_pure_constr a;
           Format.printf "@\n====== universes ====@\n";
-          Feedback.msg_notice (Univ.pr_universes
+          chk_pp
+            (Univ.pr_universes
             (ctx.Environ.env_stratification.Environ.env_universes));
           str "\nCantApplyBadType at argument " ++ int n
       | CantApplyNonFunctional _ -> str"CantApplyNonFunctional"
@@ -309,15 +309,13 @@ let rec explain_exn = function
 		   str ", characters " ++ int e ++ str "-" ++
 		   int (e+6) ++ str ")")) ++
 	       report ())
-  | e -> Errors.print e (* for anomalies and other uncaught exceptions *)
+  | e -> CErrors.print e (* for anomalies and other uncaught exceptions *)
 
 let parse_args argv =
   let rec parse = function
     | [] -> ()
     | "-impredicative-set" :: rem ->
       set_impredicative_set (); parse rem
-    | "-type-in-type" :: rem ->
-      set_type_in_type (); parse rem
 
     | "-coqlib" :: s :: rem ->
       if not (exists_dir s) then 
@@ -337,7 +335,7 @@ let parse_args argv =
     | "-debug" :: rem -> set_debug (); parse rem
 
     | "-where" :: _ ->
-        Envars.set_coqlib ~fail:Errors.error;
+        Envars.set_coqlib ~fail:CErrors.error;
         print_endline (Envars.coqlib ());
         exit 0
 
@@ -375,7 +373,7 @@ let init_with_argv argv =
     try
       parse_args argv;
       if !Flags.debug then Printexc.record_backtrace true;
-      Envars.set_coqlib ~fail:Errors.error;
+      Envars.set_coqlib ~fail:CErrors.error;
       if_verbose print_header ();
       init_load_path ();
       engage ();
diff --git a/checker/cic.mli b/checker/cic.mli
index 00ac2f56c..364558755 100644
--- a/checker/cic.mli
+++ b/checker/cic.mli
@@ -167,9 +167,8 @@ type action
 (** Engagements *)
 
 type set_predicativity = ImpredicativeSet | PredicativeSet
-type type_hierarchy = TypeInType | StratifiedType
 
-type engagement = set_predicativity * type_hierarchy
+type engagement = set_predicativity
 
 (** {6 Representation of constants (Definition/Axiom) } *)
 
@@ -212,6 +211,16 @@ type constant_def =
 
 type constant_universes = Univ.universe_context
 
+(** The [typing_flags] are instructions to the type-checker which
+    modify its behaviour. The typing flags used in the type-checking
+    of a constant are tracked in their {!constant_body} so that they
+    can be displayed to the user. *)
+type typing_flags = {
+  check_guarded : bool; (** If [false] then fixed points and co-fixed
+                            points are assumed to be total. *)
+  check_universes : bool; (** If [false] universe constraints are not checked *)
+}
+
 type constant_body = {
     const_hyps : section_context; (** New: younger hyp at top *)
     const_body : constant_def;
@@ -220,7 +229,9 @@ type constant_body = {
     const_polymorphic : bool; (** Is it polymorphic or not *)
     const_universes : constant_universes;
     const_proj : projection_body option;
-    const_inline_code : bool }
+    const_inline_code : bool;
+    const_typing_flags : typing_flags;
+}
 
 (** {6 Representation of mutual inductive types } *)
 
@@ -316,9 +327,7 @@ type mutual_inductive_body = {
 
     mind_private : bool option; (** allow pattern-matching: Some true ok, Some false blocked *)
 
-(** {8 Data for native compilation } *)
-
-    mind_native_name : native_name ref; (** status of the code (linked or not, and where) *)
+    mind_typing_flags : typing_flags; (** typing flags at the time of the inductive creation *)
   }
 
 (** {6 Module declarations } *)
diff --git a/checker/environ.ml b/checker/environ.ml
index 9352f71ef..7b59c6b98 100644
--- a/checker/environ.ml
+++ b/checker/environ.ml
@@ -1,4 +1,4 @@
-open Errors
+open CErrors
 open Util
 open Names
 open Cic
@@ -33,26 +33,21 @@ let empty_env = {
   env_rel_context = [];
   env_stratification =
   { env_universes = Univ.initial_universes;
-    env_engagement = (PredicativeSet,StratifiedType)};
+    env_engagement = PredicativeSet };
   env_imports = MPmap.empty }
 
 let engagement env = env.env_stratification.env_engagement
 let universes env = env.env_stratification.env_universes
 let rel_context env = env.env_rel_context
 
-let set_engagement (impr_set,type_in_type as c) env =
-  let expected_impr_set,expected_type_in_type =
+let set_engagement (impr_set as c) env =
+  let expected_impr_set =
     env.env_stratification.env_engagement in
   begin
     match impr_set,expected_impr_set with
     | PredicativeSet, ImpredicativeSet -> error "Incompatible engagement"
     | _ -> ()
   end;
-  begin
-    match type_in_type,expected_type_in_type with
-    | StratifiedType, TypeInType -> error "Incompatible engagement"
-    | _ -> ()
-  end;
   { env with env_stratification =
       { env.env_stratification with env_engagement = c } }
 
diff --git a/checker/esubst.ml b/checker/esubst.ml
deleted file mode 120000
index b82bd24f1..000000000
--- a/checker/esubst.ml
+++ /dev/null
@@ -1 +0,0 @@
-../kernel/esubst.ml
\ No newline at end of file
diff --git a/checker/esubst.mli b/checker/esubst.mli
deleted file mode 120000
index e30eaae5d..000000000
--- a/checker/esubst.mli
+++ /dev/null
@@ -1 +0,0 @@
-../kernel/esubst.mli
\ No newline at end of file
diff --git a/checker/include b/checker/include
index f5bd2984e..6bea3c91a 100644
--- a/checker/include
+++ b/checker/include
@@ -31,7 +31,7 @@ open Typeops;;
 open Check;;
 
 open Pp;;
-open Errors;;
+open CErrors;;
 open Util;;
 open Names;;
 open Term;;
diff --git a/checker/indtypes.ml b/checker/indtypes.ml
index a667bb8a3..27f79e796 100644
--- a/checker/indtypes.ml
+++ b/checker/indtypes.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-open Errors
+open CErrors
 open Util
 open Names
 open Cic
@@ -44,7 +44,7 @@ let prcon c =
 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
+   let t' = whd_all env t in
    if noccur_between x nvars t' then Some t'
    else None
 
@@ -90,7 +90,7 @@ exception InductiveError of inductive_error
 (* Typing the arities and constructor types *)
 
 let rec sorts_of_constr_args env t =
-  let t = whd_betadeltaiota_nolet env t in
+  let t = whd_allnolet env t in
   match t with
     | Prod (name,c1,c2) ->
         let varj = infer_type env c1 in
@@ -176,7 +176,7 @@ let typecheck_arity env params inds =
 (* Allowed eliminations *)
 
 let check_predicativity env s small level =
-  match s, fst (engagement env) with
+  match s, engagement env with
       Type u, _ ->
         (* let u' = fresh_local_univ () in *)
         (* let cst = *)
@@ -321,7 +321,7 @@ let check_correct_par (env,n,ntypes,_) hyps l largs =
     | [] -> ()
     | LocalDef _ :: hyps -> check k (index+1) hyps
     | _::hyps ->
-        match whd_betadeltaiota env lpar.(k) with
+        match whd_all env lpar.(k) with
 	  | Rel w when w = index -> check (k-1) (index+1) hyps
 	  | _ -> raise (IllFormedInd (LocalNonPar (k+1,index,l)))
   in check (nparams-1) (n-nhyps) hyps;
@@ -342,7 +342,7 @@ let check_rec_par (env,n,_,_) hyps nrecp largs =
           failwith "number of recursive parameters cannot be greater than the number of parameters."
       | (lp,LocalDef _ :: hyps) -> find (index-1) (lp,hyps)
       | (p::lp,_::hyps) ->
-          (match whd_betadeltaiota env p with
+          (match whd_all env p with
 	    | Rel w when w = index -> find (index-1) (lp,hyps)
             | _ -> failwith "bad number of recursive parameters")
   in find (n-1) (lpar,List.rev hyps)
@@ -388,7 +388,7 @@ let ienv_push_inductive (env, n, ntypes, ra_env) ((mi,u),lpar) =
 
 let rec ienv_decompose_prod (env,_,_,_ as ienv) n c =
   if n=0 then (ienv,c) else
-    let c' = whd_betadeltaiota env c in
+    let c' = whd_all env c in
     match c' with
 	Prod(na,a,b) ->
 	  let ienv' = ienv_push_var ienv (na,a,mk_norec) in
@@ -401,7 +401,7 @@ let check_positivity_one (env, _,ntypes,_ as ienv) hyps nrecp (_,i as ind) indlc
   let lparams = rel_context_length hyps in
   (* check the inductive types occur positively in [c] *)
   let rec check_pos (env, n, ntypes, ra_env as ienv) c =
-    let x,largs = decompose_app (whd_betadeltaiota env c) in
+    let x,largs = decompose_app (whd_all env c) in
       match x with
 	| Prod (na,b,d) ->
 	    assert (List.is_empty largs);
@@ -470,7 +470,7 @@ let check_positivity_one (env, _,ntypes,_ as ienv) hyps nrecp (_,i as ind) indlc
 
   and check_constructors ienv check_head c =
     let rec check_constr_rec (env,n,ntypes,ra_env as ienv) lrec c =
-      let x,largs = decompose_app (whd_betadeltaiota env c) in
+      let x,largs = decompose_app (whd_all env c) in
 	match x with
           | Prod (na,b,d) ->
 	      assert (List.is_empty largs);
diff --git a/checker/inductive.ml b/checker/inductive.ml
index 43a32ea24..c4ffc141f 100644
--- a/checker/inductive.ml
+++ b/checker/inductive.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-open Errors
+open CErrors
 open Util
 open Names
 open Cic
@@ -31,20 +31,20 @@ let lookup_mind_specif env (kn,tyi) =
   (mib, mib.mind_packets.(tyi))
 
 let find_rectype env c =
-  let (t, l) = decompose_app (whd_betadeltaiota env c) in
+  let (t, l) = decompose_app (whd_all env c) in
   match t with
   | Ind ind -> (ind, l)
   | _ -> raise Not_found
 
 let find_inductive env c =
-  let (t, l) = decompose_app (whd_betadeltaiota env c) in
+  let (t, l) = decompose_app (whd_all env c) in
   match t with
     | Ind (ind,_)
         when (fst (lookup_mind_specif env ind)).mind_finite != CoFinite -> (ind, l)
     | _ -> raise Not_found
 
 let find_coinductive env c =
-  let (t, l) = decompose_app (whd_betadeltaiota env c) in
+  let (t, l) = decompose_app (whd_all env c) in
   match t with
     | Ind (ind,_)
         when (fst (lookup_mind_specif env ind)).mind_finite == CoFinite -> (ind, l)
@@ -59,16 +59,6 @@ let inductive_instance mib =
     UContext.instance mib.mind_universes
   else Instance.empty
 
-let inductive_context mib =
-  if mib.mind_polymorphic then 
-    instantiate_univ_context mib.mind_universes 
-  else UContext.empty
-
-let instantiate_inductive_constraints mib u =
-  if mib.mind_polymorphic then
-    subst_instance_constraints u (UContext.constraints mib.mind_universes)
-  else Constraint.empty
-
 (************************************************************************)
 
 (* Build the substitution that replaces Rels by the appropriate *)
@@ -190,8 +180,6 @@ let rec make_subst env =
   in
   make Univ.LMap.empty
 
-exception SingletonInductiveBecomesProp of Id.t
-
 let instantiate_universes env ctx ar argsorts =
   let args = Array.to_list argsorts in
   let subst = make_subst env (ctx,ar.template_param_levels,args) in
@@ -208,11 +196,7 @@ let instantiate_universes env ctx ar argsorts =
 
 (* Type of an inductive type *)
 
-let is_prop_sort = function
-  | Prop Null -> true
-  | _ -> false
-
-let type_of_inductive_gen ?(polyprop=true) env ((mib,mip),u) paramtyps =
+let type_of_inductive_gen env ((mib,mip),u) paramtyps =
   match mip.mind_arity with
   | RegularArity a ->
     if not mib.mind_polymorphic then a.mind_user_arity
@@ -220,25 +204,7 @@ let type_of_inductive_gen ?(polyprop=true) env ((mib,mip),u) paramtyps =
   | TemplateArity ar ->
     let ctx = List.rev mip.mind_arity_ctxt in
     let ctx,s = instantiate_universes env ctx ar paramtyps in
-      (* The Ocaml extraction cannot handle (yet?) "Prop-polymorphism", i.e.
-         the situation where a non-Prop singleton inductive becomes Prop
-         when applied to Prop params *)
-      if not polyprop && not (Univ.is_type0m_univ ar.template_level) && is_prop_sort s
-      then raise (SingletonInductiveBecomesProp mip.mind_typename);
-      mkArity (List.rev ctx,s)
-
-let type_of_inductive env pind = 
-  type_of_inductive_gen env pind [||]
-
-let constrained_type_of_inductive env ((mib,mip),u as pind) =
-  let ty = type_of_inductive_gen env pind [||] in
-  let cst = instantiate_inductive_constraints mib u in
-    (ty, cst)
-
-let constrained_type_of_inductive_knowing_parameters env ((mib,mip),u as pind) args =
-  let ty = type_of_inductive_gen env pind args in
-  let cst = instantiate_inductive_constraints mib u in
-    (ty, cst)
+    mkArity (List.rev ctx,s)
 
 let type_of_inductive_knowing_parameters env mip args = 
   type_of_inductive_gen env mip args
@@ -275,16 +241,6 @@ let type_of_constructor_gen (cstr,u) (mib,mip as mspec) =
 let type_of_constructor cstru mspec = 
   type_of_constructor_gen cstru mspec
 
-let type_of_constructor_in_ctx cstr (mib,mip as mspec) =
-  let u = Univ.UContext.instance mib.mind_universes in
-  let c = type_of_constructor_gen (cstr, u) mspec in
-    (c, mib.mind_universes)
-
-let constrained_type_of_constructor (cstr,u as cstru) (mib,mip as ind) =
-  let ty = type_of_constructor_gen cstru ind in
-  let cst = instantiate_inductive_constraints mib u in
-    (ty, cst)
-
 let arities_of_specif (kn,u) (mib,mip) =
   let specif = mip.mind_nf_lc in
   Array.map (constructor_instantiate kn u mib) specif
@@ -343,7 +299,7 @@ let check_allowed_sort ksort specif =
 let is_correct_arity env c (p,pj) ind specif params =
   let arsign,_ = get_instantiated_arity ind specif params in
   let rec srec env pt ar =
-    let pt' = whd_betadeltaiota env pt in
+    let pt' = whd_all env pt in
     match pt', ar with
       | Prod (na1,a1,t), LocalAssum (_,a1')::ar' ->
           (try conv env a1 a1'
@@ -351,7 +307,7 @@ let is_correct_arity env c (p,pj) ind specif params =
           srec (push_rel (LocalAssum (na1,a1)) env) t ar'
       | Prod (na1,a1,a2), [] -> (* whnf of t was not needed here! *)
 	 let env' = push_rel (LocalAssum (na1,a1)) env in
-     let ksort = match (whd_betadeltaiota env' a2) with
+     let ksort = match (whd_all env' a2) with
         | Sort s -> family_of_sort s
 	    | _ -> raise (LocalArity None) in
 	  let dep_ind = build_dependent_inductive ind specif params in
@@ -622,7 +578,7 @@ let check_inductive_codomain env p =
   let env = push_rel_context absctx env in
   let arctx, s = dest_prod_assum env ar in
   let env = push_rel_context arctx env in
-  let i,l' = decompose_app (whd_betadeltaiota env s) in
+  let i,l' = decompose_app (whd_all env s) in
   match i with Ind _ -> true | _ -> false 
 
 (* The following functions are almost duplicated from indtypes.ml, except
@@ -646,7 +602,7 @@ let ienv_push_inductive (env, ra_env) ((mind,u),lpar) =
 
 let rec ienv_decompose_prod (env,_ as ienv) n c =
  if Int.equal n 0 then (ienv,c) else
-   let c' = whd_betadeltaiota env c in
+   let c' = whd_all env c in
    match c' with
    Prod(na,a,b) ->
      let ienv' = ienv_push_var ienv (na,a,mk_norec) in
@@ -676,7 +632,7 @@ close to check_positive in indtypes.ml, but does no positivy check and does not
 compute the number of recursive arguments. *)
 let get_recargs_approx env tree ind args =
   let rec build_recargs (env, ra_env as ienv) tree c =
-    let x,largs = decompose_app (whd_betadeltaiota env c) in
+    let x,largs = decompose_app (whd_all env c) in
     match x with
     | Prod (na,b,d) ->
        assert (List.is_empty largs);
@@ -735,7 +691,7 @@ let get_recargs_approx env tree ind args =
 
   and build_recargs_constructors ienv trees c =
     let rec recargs_constr_rec (env,ra_env as ienv) trees lrec c =
-      let x,largs = decompose_app (whd_betadeltaiota env c) in
+      let x,largs = decompose_app (whd_all env c) in
 	match x with
 
           | Prod (na,b,d) ->
@@ -764,7 +720,7 @@ let restrict_spec env spec p =
   let env = push_rel_context absctx env in
   let arctx, s = dest_prod_assum env ar in
   let env = push_rel_context arctx env in
-  let i,args = decompose_app (whd_betadeltaiota env s) in
+  let i,args = decompose_app (whd_all env s) in
   match i with
   | Ind i ->
      begin match spec with
@@ -786,7 +742,7 @@ let restrict_spec env spec p =
 
 let rec subterm_specif renv stack t =
   (* maybe reduction is not always necessary! *)
-  let f,l = decompose_app (whd_betadeltaiota renv.env t) in
+  let f,l = decompose_app (whd_all renv.env t) in
     match f with
       | Rel k -> subterm_var k renv
 
@@ -900,11 +856,11 @@ let filter_stack_domain env ci p stack =
   if noccur_with_meta 1 (rel_context_length absctx) ar then stack
   else let env = push_rel_context absctx env in
   let rec filter_stack env ar stack =
-    let t = whd_betadeltaiota env ar in
+    let t = whd_all env ar in
     match stack, t with
     | elt :: stack', Prod (n,a,c0) ->
       let d = LocalAssum (n,a) in
-      let ty, args = decompose_app (whd_betadeltaiota env a) in
+      let ty, args = decompose_app (whd_all env a) in
       let elt = match ty with
       | Ind ind -> 
         let spec' = stack_element_specif elt in
@@ -1033,6 +989,10 @@ let check_one_fix renv recpos trees def =
         | (Ind _ | Construct _) ->
             List.iter (check_rec_call renv []) l
 
+	| Proj (p, c) ->
+            List.iter (check_rec_call renv []) l;
+            check_rec_call renv [] c
+
         | Var _ -> anomaly (Pp.str "Section variable in Coqchk !")
 
 	| Sort _ -> assert (l = [])
@@ -1042,8 +1002,6 @@ let check_one_fix renv recpos trees def =
 
         | (App _ | LetIn _ | Cast _) -> assert false (* beta zeta reduction *)
 
-	| Proj (p, c) -> check_rec_call renv [] c
-
   and check_nested_fix_body renv decr recArgsDecrArg body =
     if decr = 0 then
       check_rec_call (assign_var_spec renv (1,recArgsDecrArg)) [] body
@@ -1076,7 +1034,7 @@ let inductive_of_mutfix env ((nvect,bodynum),(names,types,bodies as recdef)) =
     (* check fi does not appear in the k+1 first abstractions,
        gives the type of the k+1-eme abstraction (must be an inductive)  *)
     let rec check_occur env n def =
-      match (whd_betadeltaiota env def) with
+      match (whd_all env def) with
         | Lambda (x,a,b) ->
 	    if noccur_with_meta n nbfix a then
 	      let env' = push_rel (LocalAssum (x,a)) env in
@@ -1125,7 +1083,7 @@ let anomaly_ill_typed () =
   anomaly ~label:"check_one_cofix" (Pp.str "too many arguments applied to constructor")
 
 let rec codomain_is_coind env c =
-  let b = whd_betadeltaiota env c in
+  let b = whd_all env c in
   match b with
     | Prod (x,a,b) ->
 	codomain_is_coind (push_rel (LocalAssum (x,a)) env) b
@@ -1137,7 +1095,7 @@ let rec codomain_is_coind env c =
 let check_one_cofix env nbfix def deftype =
   let rec check_rec_call env alreadygrd n tree vlra  t =
     if not (noccur_with_meta n nbfix t) then
-      let c,args = decompose_app (whd_betadeltaiota env t) in
+      let c,args = decompose_app (whd_all env t) in
       match c with
 	| Rel p when  n <= p && p < n+nbfix ->
 	    (* recursive call: must be guarded and no nested recursive
diff --git a/checker/modops.ml b/checker/modops.ml
index 442f999bb..aba9da2fe 100644
--- a/checker/modops.ml
+++ b/checker/modops.ml
@@ -7,7 +7,7 @@
 (************************************************************************)
 
 (*i*)
-open Errors
+open CErrors
 open Util
 open Pp
 open Names
@@ -33,7 +33,7 @@ let error_no_such_label_sub l l1 =
          Label.to_string l^" is missing in "^l1^".")
 
 let error_not_a_module_loc loc s =
-  user_err_loc (loc,"",str ("\""^Label.to_string s^"\" is not a module"))
+  user_err ~loc  (str ("\""^Label.to_string s^"\" is not a module"))
 
 let error_not_a_module s = error_not_a_module_loc Loc.ghost s
 
diff --git a/checker/names.ml b/checker/names.ml
deleted file mode 120000
index f0bf2f83f..000000000
--- a/checker/names.ml
+++ /dev/null
@@ -1 +0,0 @@
-../kernel/names.ml
\ No newline at end of file
diff --git a/checker/names.mli b/checker/names.mli
deleted file mode 120000
index 10459f3b2..000000000
--- a/checker/names.mli
+++ /dev/null
@@ -1 +0,0 @@
-../kernel/names.mli
\ No newline at end of file
diff --git a/checker/print.ml b/checker/print.ml
index c0d1ac368..7ef752b00 100644
--- a/checker/print.ml
+++ b/checker/print.ml
@@ -10,7 +10,9 @@ open Format
 open Cic
 open Names
 
-let print_instance i = Feedback.msg_notice (Univ.Instance.pr i)
+let chk_pp = Pp.pp_with Format.std_formatter
+
+let print_instance i = chk_pp (Univ.Instance.pr i)
 
 let print_pure_constr csr =
   let rec term_display c = match  c with
@@ -108,7 +110,7 @@ let print_pure_constr csr =
   and sort_display = function
     | Prop(Pos) -> print_string "Set"
     | Prop(Null) -> print_string "Prop"
-    | Type u -> print_string "Type("; Feedback.msg_notice (Univ.pr_uni u); print_string ")"
+    | Type u -> print_string "Type("; chk_pp (Univ.pr_uni u); print_string ")"
 
   and name_display = function
     | Name id -> print_string (Id.to_string id)
diff --git a/checker/reduction.ml b/checker/reduction.ml
index f1aa5d919..ec16aa261 100644
--- a/checker/reduction.ml
+++ b/checker/reduction.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-open Errors
+open CErrors
 open Util
 open Cic
 open Term
@@ -92,13 +92,13 @@ let whd_betaiotazeta x =
        Prod _|Lambda _|Fix _|CoFix _) -> x
     | _ -> whd_val (create_clos_infos betaiotazeta empty_env) (inject x)
 
-let whd_betadeltaiota env t =
+let whd_all env t =
   match t with
     | (Sort _|Meta _|Evar _|Ind _|Construct _|
        Prod _|Lambda _|Fix _|CoFix _) -> t
     | _ -> whd_val (create_clos_infos betadeltaiota env) (inject t)
 
-let whd_betadeltaiota_nolet env t =
+let whd_allnolet env t =
   match t with
     | (Sort _|Meta _|Evar _|Ind _|Construct _|
        Prod _|Lambda _|Fix _|CoFix _|LetIn _) -> t
@@ -167,8 +167,9 @@ let sort_cmp env univ pb s0 s1 =
             CUMUL -> ()
           | _ -> raise NotConvertible)
     | (Type u1, Type u2) ->
-        if snd (engagement env) == StratifiedType
-          && not
+        (** FIXME: handle type-in-type option here *)
+        if (* snd (engagement env) == StratifiedType && *)
+          not
 	  (match pb with
             | CONV -> Univ.check_eq univ u1 u2
 	    | CUMUL -> Univ.check_leq univ u1 u2)
@@ -476,7 +477,7 @@ let vm_conv cv_pb = fconv cv_pb true
  * error message. *)
 
 let hnf_prod_app env t n =
-  match whd_betadeltaiota env t with
+  match whd_all env t with
     | Prod (_,_,b) -> subst1 n b
     | _ -> anomaly ~label:"hnf_prod_app" (Pp.str "Need a product")
 
@@ -487,7 +488,7 @@ let hnf_prod_applist env t nl =
 
 let dest_prod env =
   let rec decrec env m c =
-    let t = whd_betadeltaiota env c in
+    let t = whd_all env c in
     match t with
       | Prod (n,a,c0) ->
           let d = LocalAssum (n,a) in
@@ -499,7 +500,7 @@ let dest_prod env =
 (* The same but preserving lets in the context, not internal ones. *)
 let dest_prod_assum env =
   let rec prodec_rec env l ty =
-    let rty = whd_betadeltaiota_nolet env ty in
+    let rty = whd_allnolet env ty in
     match rty with
     | Prod (x,t,c)  ->
         let d = LocalAssum (x,t) in
@@ -509,7 +510,7 @@ let dest_prod_assum env =
 	prodec_rec (push_rel d env) (d::l) c
     | Cast (c,_,_)    -> prodec_rec env l c
     | _               ->
-      let rty' = whd_betadeltaiota env rty in
+      let rty' = whd_all env rty in
 	if Term.eq_constr rty' rty then l, rty
 	else prodec_rec env l rty'
   in
@@ -517,7 +518,7 @@ let dest_prod_assum env =
 
 let dest_lam_assum env =
   let rec lamec_rec env l ty =
-    let rty = whd_betadeltaiota_nolet env ty in
+    let rty = whd_allnolet env ty in
     match rty with
     | Lambda (x,t,c)  ->
         let d = LocalAssum (x,t) in
diff --git a/checker/reduction.mli b/checker/reduction.mli
index 2f551f4a6..15a2df1f1 100644
--- a/checker/reduction.mli
+++ b/checker/reduction.mli
@@ -16,8 +16,8 @@ open Environ
 (*s Reduction functions *)
 
 val whd_betaiotazeta        : constr -> constr
-val whd_betadeltaiota       : env -> constr -> constr
-val whd_betadeltaiota_nolet : env -> constr -> constr
+val whd_all       : env -> constr -> constr
+val whd_allnolet : env -> constr -> constr
 
 (************************************************************************)
 (*s conversion functions *)
diff --git a/checker/safe_typing.ml b/checker/safe_typing.ml
index 1071e2f93..53d80c6d5 100644
--- a/checker/safe_typing.ml
+++ b/checker/safe_typing.ml
@@ -7,7 +7,7 @@
 (************************************************************************)
 
 open Pp
-open Errors
+open CErrors
 open Util
 open Cic
 open Names
@@ -35,20 +35,15 @@ let full_add_module dp mb univs digest =
   genv := add_digest env dp digest
 
 (* Check that the engagement expected by a library extends the initial one *)
-let check_engagement env (expected_impredicative_set,expected_type_in_type) =
-  let impredicative_set,type_in_type = Environ.engagement env in
+let check_engagement env expected_impredicative_set =
+  let impredicative_set = Environ.engagement env in
   begin
     match impredicative_set, expected_impredicative_set with
     | PredicativeSet, ImpredicativeSet ->
-        Errors.error "Needs option -impredicative-set."
+        CErrors.error "Needs option -impredicative-set."
     | _ -> ()
   end;
-  begin
-    match type_in_type, expected_type_in_type with
-    | StratifiedType, TypeInType ->
-        Errors.error "Needs option -type-in-type."
-    | _ -> ()
-  end
+  ()
 
 (* Libraries = Compiled modules *)
 
@@ -94,6 +89,6 @@ let import file clib univs digest =
 let unsafe_import file clib univs digest =
   let env = !genv in
   if !Flags.debug then check_imports Feedback.msg_warning clib.comp_name env clib.comp_deps
-  else check_imports (errorlabstrm"unsafe_import") clib.comp_name env clib.comp_deps;
+  else check_imports (user_err ~hdr:"unsafe_import") clib.comp_name env clib.comp_deps;
   check_engagement env clib.comp_enga;
   full_add_module clib.comp_name clib.comp_mod univs digest
diff --git a/checker/subtyping.ml b/checker/subtyping.ml
index 46d21f6cc..7eae9b831 100644
--- a/checker/subtyping.ml
+++ b/checker/subtyping.ml
@@ -7,7 +7,7 @@
 (************************************************************************)
 
 (*i*)
-open Errors
+open CErrors
 open Util
 open Names
 open Cic
@@ -302,7 +302,7 @@ let check_constant env mp1 l info1 cb2 spec2 subst1 subst2 =
 		let c2 = force_constr lc2 in
 		check_conv conv env c1 c2))
       | IndType ((kn,i),mind1) ->
-	  ignore (Errors.error (
+	  ignore (CErrors.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 " ^
@@ -313,7 +313,7 @@ let check_constant env mp1 l info1 cb2 spec2 subst1 subst2 =
       let typ2 = Typeops.type_of_constant_type env cb2.const_type in
        check_conv conv_leq env arity1 typ2
    | IndConstr (((kn,i),j) as cstr,mind1) ->
-      ignore (Errors.error (
+      ignore (CErrors.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 " ^
diff --git a/checker/term.ml b/checker/term.ml
index 56cc9cdc2..591348cb6 100644
--- a/checker/term.ml
+++ b/checker/term.ml
@@ -8,7 +8,7 @@
 
 (* This module instantiates the structure of generic deBruijn terms to Coq *)
 
-open Errors
+open CErrors
 open Util
 open Names
 open Esubst
diff --git a/checker/term.mli b/checker/term.mli
index 0af83e05d..6b026d056 100644
--- a/checker/term.mli
+++ b/checker/term.mli
@@ -4,8 +4,6 @@ open Cic
 val family_of_sort : sorts -> sorts_family
 val family_equal : sorts_family -> sorts_family -> bool
 
-val strip_outer_cast : constr -> constr
-val collapse_appl : constr -> constr
 val decompose_app : constr -> constr * constr list
 val applist : constr * constr list -> constr
 val iter_constr_with_binders :
diff --git a/checker/typeops.ml b/checker/typeops.ml
index da9842a8d..173e19ce1 100644
--- a/checker/typeops.ml
+++ b/checker/typeops.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-open Errors
+open CErrors
 open Util
 open Names
 open Cic
@@ -33,7 +33,7 @@ let check_constraints cst env =
 
 (* This should be a type (a priori without intension to be an assumption) *)
 let type_judgment env (c,ty as j) =
-  match whd_betadeltaiota env ty with
+  match whd_all env ty with
     | Sort s -> (c,s)
     | _ -> error_not_type env j
 
@@ -107,7 +107,7 @@ let judge_of_apply env (f,funj) argjv =
   let rec apply_rec n typ = function
     | [] -> typ
     | (h,hj)::restjl ->
-        (match whd_betadeltaiota env typ with
+        (match whd_all env typ with
           | Prod (_,c1,c2) ->
 	      (try conv_leq env hj c1
 	      with NotConvertible ->
@@ -128,7 +128,7 @@ let sort_of_product env domsort rangsort =
     | (Prop _,  Prop Pos) -> rangsort
     (* Product rule (Type,Set,?) *)
     | (Type u1, Prop Pos) ->
-        if fst (engagement env) = ImpredicativeSet then
+        if engagement env = ImpredicativeSet then
           (* Rule is (Type,Set,Set) in the Set-impredicative calculus *)
           rangsort
         else
diff --git a/checker/univ.ml b/checker/univ.ml
index 96d827013..668f3a058 100644
--- a/checker/univ.ml
+++ b/checker/univ.ml
@@ -14,7 +14,7 @@
 (* Revisions by Bruno Barras, Hugo Herbelin, Pierre Letouzey *)
 
 open Pp
-open Errors
+open CErrors
 open Util
 
 (* Universes are stratified by a partial ordering $\le$.
diff --git a/checker/values.ml b/checker/values.ml
index 19cbb5060..c175aed68 100644
--- a/checker/values.ml
+++ b/checker/values.ml
@@ -13,7 +13,7 @@
 To ensure this file is up-to-date, 'make' now compares the md5 of cic.mli
 with a copy we maintain here:
 
-MD5 9f7fd499f812b6548a55f7067e6a9d06 checker/cic.mli
+MD5 6466d8cc443b5896cb905776df0cc49e  checker/cic.mli
 
 *)
 
@@ -194,8 +194,7 @@ let v_lazy_constr =
 (** kernel/declarations *)
 
 let v_impredicative_set = v_enum "impr-set" 2
-let v_type_in_type = v_enum "type-in-type" 2
-let v_engagement = v_tuple "eng" [|v_impredicative_set; v_type_in_type|]
+let v_engagement = v_impredicative_set
 
 let v_pol_arity =
   v_tuple "polymorphic_arity" [|List(Opt v_level);v_univ|]
@@ -213,6 +212,9 @@ let v_projbody =
 	    v_tuple "proj_eta" [|v_constr;v_constr|];
 	    v_constr|]
 
+let v_typing_flags =
+  v_tuple "typing_flags" [|v_bool; v_bool|]
+
 let v_cb = v_tuple "constant_body"
   [|v_section_ctxt;
     v_cst_def;
@@ -221,7 +223,8 @@ let v_cb = v_tuple "constant_body"
     v_bool;
     v_context;
     Opt v_projbody;
-    v_bool|]
+    v_bool;
+    v_typing_flags|]
 
 let v_recarg = v_sum "recarg" 1 (* Norec *)
   [|[|v_ind|] (* Mrec *);[|v_ind|] (* Imbr *)|]
@@ -270,7 +273,8 @@ let v_ind_pack = v_tuple "mutual_inductive_body"
     v_rctxt;
     v_bool;
     v_context;
-    Opt v_bool|]
+    Opt v_bool;
+    v_typing_flags|]
 
 let v_with =
   Sum ("with_declaration_body",0,
diff --git a/config/coq_config.mli b/config/coq_config.mli
index a0e1019fa..c171bd355 100644
--- a/config/coq_config.mli
+++ b/config/coq_config.mli
@@ -32,7 +32,7 @@ val cflags : string     (* arguments passed to gcc *)
 val best : string       (* byte/opt *)
 val arch : string       (* architecture *)
 val arch_is_win32 : bool
-val osdeplibs : string  (* OS dependant link options for ocamlc *)
+val osdeplibs : string  (* OS dependent link options for ocamlc *)
 val vmbyteflags : string list (* -custom/-dllib -lcoqrun *)
 
 
@@ -51,7 +51,7 @@ val exec_extension : string (* "" under Unix, ".exe" under MS-windows *)
 val with_geoproof : bool ref (* to (de)activate functions specific to Geoproof with Coqide *)
 
 val browser : string
-(** default web browser to use, may be overriden by environment
+(** default web browser to use, may be overridden by environment
     variable COQREMOTEBROWSER *)
 
 val has_coqide : string
@@ -62,6 +62,7 @@ val natdynlinkflag : string (* special cases of natdynlink (e.g. MacOS 10.5) *)
 
 val wwwcoq : string
 val wwwrefman : string
+val wwwbugtracker : string
 val wwwstdlib : string
 val localwwwrefman : string
 
diff --git a/configure b/configure
index 09585e59e..79c512f8a 100755
--- a/configure
+++ b/configure
@@ -26,7 +26,7 @@ done
 
 ## We check that $cmd is ok before the real exec $cmd
 
-`$cmd -version > /dev/null 2>&1` && exec $cmd $script "$@"
+`$cmd -version > /dev/null 2>&1` && exec $cmd -w "-3" $script "$@"
 
 ## If we're still here, something is wrong with $cmd
 
diff --git a/configure.ml b/configure.ml
index ade43810b..48e167c99 100644
--- a/configure.ml
+++ b/configure.ml
@@ -12,10 +12,10 @@
 open Printf
 
 let coq_version = "trunk"
-let coq_macos_version = "8.4.90" (** "[...] should be a string comprised of
-three non-negative, period-separed integers [...]" *)
-let vo_magic = 8511
-let state_magic = 58511
+let coq_macos_version = "8.6.90" (** "[...] should be a string comprised of
+three non-negative, period-separated integers [...]" *)
+let vo_magic = 8691
+let state_magic = 58691
 let distributed_exec = ["coqtop";"coqc";"coqchk";"coqdoc";"coqmktop";"coqworkmgr";
 "coqdoc";"coq_makefile";"coq-tex";"gallina";"coqwc";"csdpcert";"coqdep"]
 
@@ -178,6 +178,19 @@ let which prog =
 let program_in_path prog =
   try let _ = which prog in true with Not_found -> false
 
+(** As per bug #4828, ocamlfind on Windows/Cygwin barfs if you pass it
+    a quoted path to camlpXo via -pp.  So we only quote camlpXo on not
+    Windows, and warn on Windows if the path contains spaces *)
+let contains_suspicious_characters str =
+  List.fold_left (fun b ch -> String.contains str ch || b) false [' '; '\t']
+
+let win_aware_quote_executable str =
+  if not (os_type_win32 || os_type_cygwin) then
+    sprintf "%S" str
+  else
+    let _ = if contains_suspicious_characters str then
+      printf "*Warning* The string %S contains suspicious characters; ocamlfind might fail\n" str in
+    Str.global_replace (Str.regexp "\\\\") "/" str
 
 (** * Date *)
 
@@ -368,7 +381,7 @@ let coq_debug_flag = if !Prefs.debug then "-g" else ""
 let coq_profile_flag = if !Prefs.profile then "-p" else ""
 let coq_annotate_flag =
   if !Prefs.annotate
-  then if program_in_path "ocamlmerlin" then "-bin-annot" else "-dtypes"
+  then if program_in_path "ocamlmerlin" then "-bin-annot" else "-annot"
   else ""
 
 let cflags = "-Wall -Wno-unused -g -O2"
@@ -417,7 +430,7 @@ let dll = if os_type_win32 then ".dll" else ".so"
 
 let vcs =
   let git_dir = try Sys.getenv "GIT_DIR" with Not_found -> ".git" in
-  if dir_exists git_dir then "git"
+  if Sys.file_exists git_dir then "git"
   else if Sys.file_exists ".svn/entries" then "svn"
   else if dir_exists "{arch}" then "gnuarch"
   else "none"
@@ -474,19 +487,14 @@ let caml_version_nums =
          "Is it installed properly?")
 
 let check_caml_version () =
-  if caml_version_nums >= [4;1;0] then
-    if caml_version_nums = [4;2;0] && not !Prefs.force_caml_version then
-      die ("Your version of OCaml is 4.02.0 which suffers from a bug inducing\n" ^
-        "very slow compilation times. If you still want to use it, use \n" ^
-        "option -force-caml-version.\n")
-    else
-      printf "You have OCaml %s. Good!\n" caml_version
+  if caml_version_nums >= [4;2;1] then
+    printf "You have OCaml %s. Good!\n" caml_version
   else
     let () = printf "Your version of OCaml is %s.\n" caml_version in
     if !Prefs.force_caml_version then
       printf "*Warning* Your version of OCaml is outdated.\n"
     else
-      die "You need OCaml 4.01 or later."
+      die "You need OCaml 4.02.1 or later."
 
 let _ = check_caml_version ()
 
@@ -501,6 +509,20 @@ let camltag = match caml_version_list with
 (** * CamlpX configuration *)
 
 (* Convention: we use camldir as a prioritary location for camlpX, if given *)
+(* i.e., in the case of camlp5, we search for a copy of camlp5o which *)
+(* answers the right camlp5 lib dir *)
+
+let strip_slash dir =
+  let n = String.length dir in
+  if n>0 && dir.[n - 1] = '/' then String.sub dir 0 (n-1) else dir
+
+let which_camlp5o_for camlp5lib =
+  let camlp5o = Filename.concat camlbin "camlp5o" in
+  let camlp5lib = strip_slash camlp5lib in
+  if fst (tryrun camlp5o ["-where"]) = camlp5lib then camlp5o else
+  let camlp5o = which "camlp5o" in
+  if fst (tryrun camlp5o ["-where"]) = camlp5lib then camlp5o else
+  die ("Error: cannot find Camlp5 binaries corresponding to Camlp5 library " ^ camlp5lib)
 
 let which_camlpX base =
   let file = Filename.concat camlbin base in
@@ -513,58 +535,40 @@ exception NoCamlp5
 
 let check_camlp5 testcma = match !Prefs.camlp5dir with
   | Some dir ->
-    if Sys.file_exists (dir/testcma) then dir
+    if Sys.file_exists (dir/testcma) then
+      let camlp5o =
+        try which_camlp5o_for dir
+        with Not_found -> die "Error: cannot find Camlp5 binaries in path.\n" in
+      dir, camlp5o
     else
       let msg =
         sprintf "Cannot find camlp5 libraries in '%s' (%s not found)."
           dir testcma
       in die msg
   | None ->
-    let dir,_ = tryrun "camlp5" ["-where"] in
-    let dir2 =
-      if Sys.file_exists (camllib/"camlp5"/testcma) then
-        camllib/"camlp5"
-      else if Sys.file_exists (camllib/"site-lib"/"camlp5"/testcma) then
-        camllib/"site-lib"/"camlp5"
-      else ""
-    in
-    (* if the two values are different then camlp5 has been relocated
-     * and will not be able to find its own files, so we prefer the
-     * path where the files actually do exist *)
-    if dir2 = "" then
-      if dir = "" then
-        let () = printf "No Camlp5 installation found." in
-        let () = printf "Looking for Camlp4 instead...\n" in
-        raise NoCamlp5
-      else dir
-    else dir2
-
-let check_camlp5_version () =
-  try
-    let camlp5o = which_camlpX "camlp5o" in
-    let version_line, _ = run ~err:StdOut camlp5o ["-v"] in
-    let version = List.nth (string_split ' ' version_line) 2 in
-    match string_split '.' version with
-    | major::minor::_ when s2i major > 5 || (s2i major, s2i minor) >= (5,1) ->
-      printf "You have Camlp5 %s. Good!\n" version; camlp5o, version
-    | _ -> failwith "bad version"
-  with
-  | Not_found -> die "Error: cannot find Camlp5 binaries in path.\n"
-  | _ -> die "Error: unsupported Camlp5 (version < 5.01 or unrecognized).\n"
-
-let check_caml_version_for_camlp4 () =
-  if caml_version_nums = [4;1;0] && !Prefs.debug && not !Prefs.force_caml_version then
-    die ("Your version of OCaml is detected to be 4.01.0 which fails to compile\n" ^
-         "Coq in -debug mode with Camlp4. Remove -debug option or use a different\n" ^
-         "version of OCaml or use Camlp5, or bypass this test by using option\n" ^
-         "-force-caml-version.\n")
+    try
+      let camlp5o = which_camlpX "camlp5o" in
+      let dir,_ = tryrun camlp5o ["-where"] in
+      dir, camlp5o
+    with Not_found ->
+      let () = printf "No Camlp5 installation found." in
+      let () = printf "Looking for Camlp4 instead...\n" in
+      raise NoCamlp5
+
+let check_camlp5_version camlp5o =
+  let version_line, _ = run ~err:StdOut camlp5o ["-v"] in
+  let version = List.nth (string_split ' ' version_line) 2 in
+  match numeric_prefix_list version with
+  | major::minor::_ when s2i major > 6 || (s2i major, s2i minor) >= (6,6) ->
+    printf "You have Camlp5 %s. Good!\n" version; version
+  | _ -> die "Error: unsupported Camlp5 (version < 6.06 or unrecognized).\n"
 
 let config_camlpX () =
   try
     if not !Prefs.usecamlp5 then raise NoCamlp5;
     let camlp5mod = "gramlib" in
-    let camlp5libdir = check_camlp5 (camlp5mod^".cma") in
-    let camlp5o, camlp5_version = check_camlp5_version () in
+    let camlp5libdir, camlp5o = check_camlp5 (camlp5mod^".cma") in
+    let camlp5_version = check_camlp5_version camlp5o in
     "camlp5", camlp5o, Filename.dirname camlp5o, camlp5libdir, camlp5mod, camlp5_version
   with NoCamlp5 ->
     (* We now try to use Camlp4, either by explicit choice or
@@ -577,7 +581,6 @@ let config_camlpX () =
       let camlp4orf = which_camlpX "camlp4orf" in
       let version_line, _ = run ~err:StdOut camlp4orf ["-v"] in
       let camlp4_version = List.nth (string_split ' ' version_line) 2 in
-      check_caml_version_for_camlp4 ();
       "camlp4", camlp4orf, Filename.dirname camlp4orf, camlp4libdir, camlp4mod, camlp4_version
     with _ -> die "No Camlp4 installation found.\n"
 
@@ -630,22 +633,8 @@ let best_compiler =
 
 let hasnatdynlink = !Prefs.natdynlink && best_compiler = "opt"
 
-(** OCaml 3.11.0 dynlink is buggy on MacOS 10.5, and possibly
-    also on 10.6.(0|1|2) for x86_64 and 10.6.x on x86_32 *)
-
-let needs_MacOS_fix () =
-  match hasnatdynlink, arch, caml_version_nums with
-  | true, "Darwin", 3::11::_ ->
-    (match string_split '.' (fst(run "uname" ["-r"])) with
-    | "9"::_ -> true
-    | "10"::("0"|"1"|"2")::_ -> true
-    | "10"::_ when Sys.word_size = 32 -> true
-    | _ -> false)
-  | _ -> false
-
 let natdynlinkflag =
-  if needs_MacOS_fix () then "os5fixme" else
-    if hasnatdynlink then "true" else "false"
+  if hasnatdynlink then "true" else "false"
 
 
 (** * OS dependent libraries *)
@@ -821,7 +810,8 @@ let strip =
 (** * md5sum command *)
 
 let md5sum =
-  if arch = "Darwin" || arch = "FreeBSD" then "md5 -q" else "md5sum"
+  if List.mem arch ["Darwin"; "FreeBSD"; "OpenBSD"]
+  then "md5 -q" else "md5sum"
 
 
 (** * Documentation : do we have latex, hevea, ... *)
@@ -946,7 +936,7 @@ let print_summary () =
   pr "\n";
   pr "  Architecture                : %s\n" arch;
   if operating_system <> "" then
-    pr "  Operating system          : %s\n" operating_system;
+    pr "  Operating system            : %s\n" operating_system;
   pr "  Coq VM bytecode link flags  : %s\n" (String.concat " " vmbyteflags);
   pr "  Other bytecode link flags   : %s\n" custom_flag;
   pr "  OS dependent libraries      : %s\n" osdeplibs;
@@ -1003,7 +993,7 @@ let write_dbg_wrapper f =
 let _ = write_dbg_wrapper "dev/ocamldebug-coq"
 
 
-(** * Build the config/coq_config.ml file (+ link to myocamlbuild_config.ml) *)
+(** * Build the config/coq_config.ml file *)
 
 let write_configml f =
   safe_remove f;
@@ -1054,6 +1044,7 @@ let write_configml f =
   pr "let with_geoproof = ref %B\n" !Prefs.geoproof;
   pr_s "browser" browser;
   pr_s "wwwcoq" !Prefs.coqwebsite;
+  pr_s "wwwbugtracker" (!Prefs.coqwebsite ^ "bugs/");
   pr_s "wwwrefman" (!Prefs.coqwebsite ^ "distrib/" ^ coq_version ^ "/refman/");
   pr_s "wwwstdlib" (!Prefs.coqwebsite ^ "distrib/" ^ coq_version ^ "/stdlib/");
   pr_s "localwwwrefman"  ("file:/" ^ docdir ^ "/html/refman");
@@ -1070,15 +1061,18 @@ let write_configml f =
   close_out o;
   Unix.chmod f 0o444
 
-let write_configml_my f f' =
-  write_configml f;
-  if os_type_win32 then
-    write_configml f'
-  else
-    (safe_remove f'; Unix.symlink f f')
+let _ = write_configml "config/coq_config.ml"
 
-let _ = write_configml_my "config/coq_config.ml" "myocamlbuild_config.ml"
+(** * Symlinks or copies for the checker *)
 
+let _ =
+  let prog, args, prf =
+    if arch = "win32" then "cp", [], ""
+    else "ln", ["-s"], "../" in
+  List.iter (fun file ->
+    ignore(run "rm" ["-f"; "checker/"^file]);
+    ignore(run ~fatal:true prog (args @ [prf^"kernel/"^file;"checker/"^file])))
+  [ "esubst.ml"; "esubst.mli"; "names.ml"; "names.mli" ]
 
 (** * Build the config/Makefile file *)
 
@@ -1100,6 +1094,7 @@ let write_makefile f =
   pr "LOCAL=%B\n\n" !Prefs.local;
   pr "# Bytecode link flags : should we use -custom or not ?\n";
   pr "CUSTOM=%s\n" custom_flag;
+  pr "VMBYTEFLAGS=%s\n" (String.concat " " vmbyteflags);
   pr "%s\n\n" !build_loadpath;
   pr "# Paths for true installation\n";
   List.iter (fun (v,msg,_,_) -> pr "# %s: path for %s\n" v msg) install_dirs;
@@ -1134,7 +1129,7 @@ let write_makefile f =
   pr "# Camlp4 : flavor, binaries, libraries ...\n";
   pr "# NB : avoid using CAMLP4LIB (conflict under Windows)\n";
   pr "CAMLP4=%s\n" camlpX;
-  pr "CAMLP4O=%S\n" camlpXo;
+  pr "CAMLP4O=%s\n" (win_aware_quote_executable camlpXo);
   pr "CAMLP4COMPAT=%s\n" camlp4compat;
   pr "MYCAMLP4LIB=%S\n\n" camlpXlibdir;
   pr "# Your architecture\n";
diff --git a/coq-win32.itarget b/coq-win32.itarget
deleted file mode 100644
index 9e2c7a2b6..000000000
--- a/coq-win32.itarget
+++ /dev/null
@@ -1,2 +0,0 @@
-binariesopt
-plugins/pluginsdyn.otarget
diff --git a/coq.itarget b/coq.itarget
deleted file mode 100644
index dd8b25905..000000000
--- a/coq.itarget
+++ /dev/null
@@ -1,8 +0,0 @@
-# NB: for the moment we start with bytecode compilation
-# for early error detection in .ml
-binariesbyte
-plugins/pluginsbyte.otarget
-binariesopt
-plugins/pluginsopt.otarget
-theories/theories.otarget
-plugins/pluginsvo.otarget
diff --git a/dev/Makefile.oug b/dev/Makefile.oug
deleted file mode 100644
index ee69ea80d..000000000
--- a/dev/Makefile.oug
+++ /dev/null
@@ -1,74 +0,0 @@
-#######################################################################
-#  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       #
-#######################################################################
-
-
-#### Source Code Analysis via Oug ####
-#### Cf http://home.gna.org/oug ####
-
-
-# To be used from top dir : make -f dev/Makefile.oug ...
-
-include Makefile.build
-
-# Oug location: in the path by default, native version
-
-OUG:=oug.x
-
-# NB: coq should have been compiled with the same ocaml version as oug
-
-# NOTA: it seems we obtain more useless elements reported when _not_
-# providing the .mli files, and also when giving a precise start point.
-# TO BE INVESTIGATED
-
-ml_of_cma = $(patsubst %.cmo,%.ml,$(filter %.cmo,$(shell cat $(1:.cma=.mllib.d))))
-local_ml_of_cma = $(filter $(dir $(1))%,$(call ml_of_cma,$(1)))
-mli_of_ml = $(foreach ml,$(1),$(wildcard $(ml)i))
-
-# Analysis of coqtop, without plugins
-
-COREML:=config/coq_config.ml $(call ml_of_cma, $(CORECMA))
-COREMLI:=$(call mli_of_ml,$(COREML))
-
-core.oug:
-	$(OUG) --dump-data $@ -rectypes $(MLINCLUDES) $(COREML)
-
-core.useless: core.oug
-	$(OUG) --load-data $< --no-reduce --print-loc --roots "<Coqtop.start>" --useless-elements $@
-
-core_intf.oug:
-	$(OUG) --dump-data $@ -rectypes $(MLINCLUDES) $(COREML) $(COREMLI)
-
-core_intf.useless: core_intf.oug
-	$(OUG) --load-data $< --no-reduce --print-loc --roots "<Coqtop.start>" --useless-elements $@
-
-# Analysis of coqchk, considering only files in the checker/ subdir
-
-CHECKERML:=$(call local_ml_of_cma,checker/check.cma)
-CHECKERMLI:=$(call mli_of_ml,$(CHECKERML))
-
-## BUG: in oug, include dirs have reversed priority compared with ocaml, cannot use CHKLIBS
-MYCHKINCL:=$(MLINCLUDES) -I checker
-
-checker.oug:
-	$(OUG) --dump-data $@ -rectypes $(MYCHKINCL) $(CHECKERML) #$(CHECKERMLI)
-
-checker.useless: checker.oug
-	$(OUG) --load-data $< --no-reduce --print-loc --roots "<Checker.start>" --useless-elements $@
-
-# Analysis of extraction
-
-EXTRACTIONML:=$(call local_ml_of_cma,$(EXTRACTIONCMA))
-EXTRACTIONMLI:=$(call mli_of_ml,$(EXTRACTIONMLI))
-
-extraction.oug:
-	$(OUG) --dump-data $@ -rectypes $(MLINCLUDES) $(EXTRACTIONML) #$(EXTRACTIONMLI)
-
-extraction.useless: extraction.oug
-	$(OUG) --load-data $< --no-reduce --print-loc --useless-elements $@
-
-# More to come ...
\ No newline at end of file
diff --git a/dev/base_db b/dev/base_db
index b540aed6c..e18ac534a 100644
--- a/dev/base_db
+++ b/dev/base_db
@@ -1,6 +1,6 @@
-load_printer "gramlib.cma"
-load_printer "top_printers.cmo"
-install_printer Top_printers.prid
-install_printer Top_printers.prsp
-install_printer Top_printers.print_pure_constr
+source core.dbg
+load_printer top_printers.cmo
+install_printer Top_printers.ppid
+install_printer Top_printers.ppsp
+install_printer Top_printers.ppconstr
 
diff --git a/dev/base_include b/dev/base_include
index 86f34b2ac..0abcefc38 100644
--- a/dev/base_include
+++ b/dev/base_include
@@ -66,7 +66,7 @@ open Univ
 open Inductive
 open Indtypes
 open Cooking
-open Closure
+open CClosure
 open Reduction
 open Safe_typing
 open Declare
@@ -170,7 +170,7 @@ open Tacticals
 open Tactics
 open Eqschemes
 
-open Cerrors
+open ExplainErr
 open Class
 open Command
 open Indschemes
@@ -195,7 +195,7 @@ let qid = Libnames.qualid_of_string;;
 (* parsing of terms *)
 
 let parse_constr = Pcoq.parse_string Pcoq.Constr.constr;;
-let parse_tac    = Pcoq.parse_string Pcoq.Tactic.tactic;;
+let parse_tac    = Pcoq.parse_string Pltac.tactic;;
 let parse_vernac = Pcoq.parse_string Pcoq.Vernac_.vernac;;
 
 (* build a term of type glob_constr without type-checking or resolution of 
diff --git a/dev/make-macos-dmg.sh b/dev/build/osx/make-macos-dmg.sh
index b43ada907..b43ada907 100755
--- a/dev/make-macos-dmg.sh
+++ b/dev/build/osx/make-macos-dmg.sh
diff --git a/dev/build/windows/CAVEATS.txt b/dev/build/windows/CAVEATS.txt
new file mode 100644
index 000000000..cb1ae3aaa
--- /dev/null
+++ b/dev/build/windows/CAVEATS.txt
@@ -0,0 +1,22 @@
+===== Environemt SIZE =====

+

+find and xargs can fail if the environment is to large. I think the limit is 8k.

+

+xargs --show-limits

+

+shows the actual environment size

+

+The configure_profile.sh script sets ORIGINAL_PATH (set by cygwin) to "" to

+avoid issues

+

+===== OCAMLLIB =====

+

+If the environment variable OCAMLLIB is defined, it takes precedence over the

+internal paths of ocaml tools. This usually messes up things considerably. A

+typical failure is

+

+Error: Error on dynamically loaded library: .\dlllablgtk2.dll: %1 is not a valid Win32 application.

+

+The configure_profile.sh script clears OCAMLLIB, but if you use the ocaml

+compiler from outside the provided cygwin shell, OCAMLLIB might be defined.

+

diff --git a/dev/build/windows/MakeCoq_84pl6_abs_ocaml.bat b/dev/build/windows/MakeCoq_84pl6_abs_ocaml.bat
new file mode 100644
index 000000000..bdcb01db9
--- /dev/null
+++ b/dev/build/windows/MakeCoq_84pl6_abs_ocaml.bat
@@ -0,0 +1,10 @@
+call MakeCoq_SetRootPath

+

+call MakeCoq_MinGW.bat ^

+  -arch=64 ^

+  -mode=absolute ^

+  -ocaml=Y ^

+  -make=Y ^

+  -coqver=8.4pl6 ^

+  -destcyg=%ROOTPATH%\cygwin_coq64_84pl6_abs ^

+  -destcoq=%ROOTPATH%\coq64_84pl6_abs

diff --git a/dev/build/windows/MakeCoq_85pl2_abs_ocaml.bat b/dev/build/windows/MakeCoq_85pl2_abs_ocaml.bat
new file mode 100644
index 000000000..2e4a692e9
--- /dev/null
+++ b/dev/build/windows/MakeCoq_85pl2_abs_ocaml.bat
@@ -0,0 +1,10 @@
+call MakeCoq_SetRootPath

+

+call MakeCoq_MinGW.bat ^

+  -arch=64 ^

+  -mode=absolute ^

+  -ocaml=Y ^

+  -make=Y ^

+  -coqver=8.5pl2 ^

+  -destcyg=%ROOTPATH%\cygwin_coq64_85pl2_abs ^

+  -destcoq=%ROOTPATH%\coq64_85pl2_abs

diff --git a/dev/build/windows/MakeCoq_85pl3_abs_ocaml.bat b/dev/build/windows/MakeCoq_85pl3_abs_ocaml.bat
new file mode 100644
index 000000000..6e4e440a2
--- /dev/null
+++ b/dev/build/windows/MakeCoq_85pl3_abs_ocaml.bat
@@ -0,0 +1,10 @@
+call MakeCoq_SetRootPath

+

+call MakeCoq_MinGW.bat ^

+  -arch=64 ^

+  -mode=absolute ^

+  -ocaml=Y ^

+  -make=Y ^

+  -coqver=8.5pl3 ^

+  -destcyg=%ROOTPATH%\cygwin_coq64_85pl3_abs ^

+  -destcoq=%ROOTPATH%\coq64_85pl3_abs

diff --git a/dev/build/windows/MakeCoq_85pl3_installer.bat b/dev/build/windows/MakeCoq_85pl3_installer.bat
new file mode 100644
index 000000000..c305e2f52
--- /dev/null
+++ b/dev/build/windows/MakeCoq_85pl3_installer.bat
@@ -0,0 +1,8 @@
+call MakeCoq_SetRootPath

+

+call MakeCoq_MinGW.bat ^

+  -arch=64 ^

+  -installer=Y ^

+  -coqver=8.5pl3 ^

+  -destcyg=%ROOTPATH%\cygwin_coq64_85pl3_inst ^

+  -destcoq=%ROOTPATH%\coq64_85pl3_inst

diff --git a/dev/build/windows/MakeCoq_85pl3_installer_32.bat b/dev/build/windows/MakeCoq_85pl3_installer_32.bat
new file mode 100644
index 000000000..d87ff5919
--- /dev/null
+++ b/dev/build/windows/MakeCoq_85pl3_installer_32.bat
@@ -0,0 +1,8 @@
+call MakeCoq_SetRootPath

+

+call MakeCoq_MinGW.bat ^

+  -arch=32 ^

+  -installer=Y ^

+  -coqver=8.5pl3 ^

+  -destcyg=%ROOTPATH%\cygwin_coq32_85pl3_inst ^

+  -destcoq=%ROOTPATH%\coq32_85pl3_inst

diff --git a/dev/build/windows/MakeCoq_86_abs_ocaml.bat b/dev/build/windows/MakeCoq_86_abs_ocaml.bat
new file mode 100644
index 000000000..50483c4d4
--- /dev/null
+++ b/dev/build/windows/MakeCoq_86_abs_ocaml.bat
@@ -0,0 +1,10 @@
+call MakeCoq_SetRootPath

+

+call MakeCoq_MinGW.bat ^

+  -arch=64 ^

+  -mode=absolute ^

+  -ocaml=Y ^

+  -make=Y ^

+  -coqver=8.6 ^

+  -destcyg=%ROOTPATH%\cygwin_coq64_86_abs ^

+  -destcoq=%ROOTPATH%\coq64_86_abs

diff --git a/dev/build/windows/MakeCoq_86_installer.bat b/dev/build/windows/MakeCoq_86_installer.bat
new file mode 100644
index 000000000..263520ff1
--- /dev/null
+++ b/dev/build/windows/MakeCoq_86_installer.bat
@@ -0,0 +1,8 @@
+call MakeCoq_SetRootPath

+

+call MakeCoq_MinGW.bat ^

+  -arch=64 ^

+  -installer=Y ^

+  -coqver=8.6 ^

+  -destcyg=%ROOTPATH%\cygwin_coq64_86_inst ^

+  -destcoq=%ROOTPATH%\coq64_86_inst

diff --git a/dev/build/windows/MakeCoq_86_installer_32.bat b/dev/build/windows/MakeCoq_86_installer_32.bat
new file mode 100644
index 000000000..14921dd7c
--- /dev/null
+++ b/dev/build/windows/MakeCoq_86_installer_32.bat
@@ -0,0 +1,8 @@
+call MakeCoq_SetRootPath

+

+call MakeCoq_MinGW.bat ^

+  -arch=32 ^

+  -installer=Y ^

+  -coqver=8.6 ^

+  -destcyg=%ROOTPATH%\cygwin_coq32_86_inst ^

+  -destcoq=%ROOTPATH%\coq32_86_inst

diff --git a/dev/build/windows/MakeCoq_86beta1_abs_ocaml.bat b/dev/build/windows/MakeCoq_86beta1_abs_ocaml.bat
new file mode 100644
index 000000000..914c332f4
--- /dev/null
+++ b/dev/build/windows/MakeCoq_86beta1_abs_ocaml.bat
@@ -0,0 +1,10 @@
+call MakeCoq_SetRootPath

+

+call MakeCoq_MinGW.bat ^

+  -arch=64 ^

+  -mode=absolute ^

+  -ocaml=Y ^

+  -make=Y ^

+  -coqver=8.6beta1 ^

+  -destcyg=%ROOTPATH%\cygwin_coq64_86beta1_abs ^

+  -destcoq=%ROOTPATH%\coq64_86beta1_abs

diff --git a/dev/build/windows/MakeCoq_86beta1_installer.bat b/dev/build/windows/MakeCoq_86beta1_installer.bat
new file mode 100644
index 000000000..76a5bb35a
--- /dev/null
+++ b/dev/build/windows/MakeCoq_86beta1_installer.bat
@@ -0,0 +1,8 @@
+call MakeCoq_SetRootPath

+

+call MakeCoq_MinGW.bat ^

+  -arch=64 ^

+  -installer=Y ^

+  -coqver=8.6beta1 ^

+  -destcyg=%ROOTPATH%\cygwin_coq64_86beta1_inst ^

+  -destcoq=%ROOTPATH%\coq64_86beta1_inst

diff --git a/dev/build/windows/MakeCoq_86beta1_installer_32.bat b/dev/build/windows/MakeCoq_86beta1_installer_32.bat
new file mode 100644
index 000000000..f53232b65
--- /dev/null
+++ b/dev/build/windows/MakeCoq_86beta1_installer_32.bat
@@ -0,0 +1,8 @@
+call MakeCoq_SetRootPath

+

+call MakeCoq_MinGW.bat ^

+  -arch=32 ^

+  -installer=Y ^

+  -coqver=8.6beta1 ^

+  -destcyg=%ROOTPATH%\cygwin_coq32_86beta1_inst ^

+  -destcoq=%ROOTPATH%\coq32_86beta1_inst

diff --git a/dev/build/windows/MakeCoq_86git_abs_ocaml.bat b/dev/build/windows/MakeCoq_86git_abs_ocaml.bat
new file mode 100644
index 000000000..f1d855a02
--- /dev/null
+++ b/dev/build/windows/MakeCoq_86git_abs_ocaml.bat
@@ -0,0 +1,10 @@
+call MakeCoq_SetRootPath

+

+call MakeCoq_MinGW.bat ^

+  -arch=64 ^

+  -mode=absolute ^

+  -ocaml=Y ^

+  -make=Y ^

+  -coqver=git-v8.6 ^

+  -destcyg=%ROOTPATH%\cygwin_coq64_86git_abs ^

+  -destcoq=%ROOTPATH%\coq64_86git_abs

diff --git a/dev/build/windows/MakeCoq_86git_abs_ocaml_gtksrc.bat b/dev/build/windows/MakeCoq_86git_abs_ocaml_gtksrc.bat
new file mode 100644
index 000000000..70ab42bc3
--- /dev/null
+++ b/dev/build/windows/MakeCoq_86git_abs_ocaml_gtksrc.bat
@@ -0,0 +1,11 @@
+call MakeCoq_SetRootPath

+

+call MakeCoq_MinGW.bat ^

+  -arch=64 ^

+  -mode=absolute ^

+  -ocaml=Y ^

+  -make=Y ^

+  -gtksrc=Y ^

+  -coqver=git-v8.6 ^

+  -destcyg=%ROOTPATH%\cygwin_coq64_86git_abs_gtksrc ^

+  -destcoq=%ROOTPATH%\coq64_86git_abs_gtksrc

diff --git a/dev/build/windows/MakeCoq_86git_installer.bat b/dev/build/windows/MakeCoq_86git_installer.bat
new file mode 100644
index 000000000..40506318e
--- /dev/null
+++ b/dev/build/windows/MakeCoq_86git_installer.bat
@@ -0,0 +1,8 @@
+call MakeCoq_SetRootPath

+

+call MakeCoq_MinGW.bat ^

+  -arch=64 ^

+  -installer=Y ^

+  -coqver=git-v8.6 ^

+  -destcyg=%ROOTPATH%\cygwin_coq64_86git_inst ^

+  -destcoq=%ROOTPATH%\coq64_86git_inst

diff --git a/dev/build/windows/MakeCoq_86git_installer2.bat b/dev/build/windows/MakeCoq_86git_installer2.bat
new file mode 100644
index 000000000..d184f0e30
--- /dev/null
+++ b/dev/build/windows/MakeCoq_86git_installer2.bat
@@ -0,0 +1,8 @@
+call MakeCoq_SetRootPath

+

+call MakeCoq_MinGW.bat ^

+  -arch=64 ^

+  -installer=Y ^

+  -coqver=git-v8.6 ^

+  -destcyg=%ROOTPATH%\cygwin_coq64_86git_inst2 ^

+  -destcoq=%ROOTPATH%\coq64_86git_inst2

diff --git a/dev/build/windows/MakeCoq_86git_installer_32.bat b/dev/build/windows/MakeCoq_86git_installer_32.bat
new file mode 100644
index 000000000..b9127c945
--- /dev/null
+++ b/dev/build/windows/MakeCoq_86git_installer_32.bat
@@ -0,0 +1,8 @@
+call MakeCoq_SetRootPath

+

+call MakeCoq_MinGW.bat ^

+  -arch=32 ^

+  -installer=Y ^

+  -coqver=git-v8.6 ^

+  -destcyg=%ROOTPATH%\cygwin_coq32_86git_inst ^

+  -destcoq=%ROOTPATH%\coq32_86git_inst

diff --git a/dev/build/windows/MakeCoq_86rc1_abs_ocaml.bat b/dev/build/windows/MakeCoq_86rc1_abs_ocaml.bat
new file mode 100644
index 000000000..c0669f01d
--- /dev/null
+++ b/dev/build/windows/MakeCoq_86rc1_abs_ocaml.bat
@@ -0,0 +1,10 @@
+call MakeCoq_SetRootPath

+

+call MakeCoq_MinGW.bat ^

+  -arch=64 ^

+  -mode=absolute ^

+  -ocaml=Y ^

+  -make=Y ^

+  -coqver=8.6rc1 ^

+  -destcyg=%ROOTPATH%\cygwin_coq64_86rc1_abs ^

+  -destcoq=%ROOTPATH%\coq64_86rc1_abs

diff --git a/dev/build/windows/MakeCoq_86rc1_installer.bat b/dev/build/windows/MakeCoq_86rc1_installer.bat
new file mode 100644
index 000000000..66234ebbd
--- /dev/null
+++ b/dev/build/windows/MakeCoq_86rc1_installer.bat
@@ -0,0 +1,8 @@
+call MakeCoq_SetRootPath

+

+call MakeCoq_MinGW.bat ^

+  -arch=64 ^

+  -installer=Y ^

+  -coqver=8.6rc1 ^

+  -destcyg=%ROOTPATH%\cygwin_coq64_86rc1_inst ^

+  -destcoq=%ROOTPATH%\coq64_86rc1_inst

diff --git a/dev/build/windows/MakeCoq_86rc1_installer_32.bat b/dev/build/windows/MakeCoq_86rc1_installer_32.bat
new file mode 100644
index 000000000..96f43e16a
--- /dev/null
+++ b/dev/build/windows/MakeCoq_86rc1_installer_32.bat
@@ -0,0 +1,8 @@
+call MakeCoq_SetRootPath

+

+call MakeCoq_MinGW.bat ^

+  -arch=32 ^

+  -installer=Y ^

+  -coqver=8.6rc1 ^

+  -destcyg=%ROOTPATH%\cygwin_coq32_86rc1_inst ^

+  -destcoq=%ROOTPATH%\coq32_86rc1_inst

diff --git a/dev/build/windows/MakeCoq_MinGW.bat b/dev/build/windows/MakeCoq_MinGW.bat
new file mode 100644
index 000000000..1e08cc5a3
--- /dev/null
+++ b/dev/build/windows/MakeCoq_MinGW.bat
@@ -0,0 +1,445 @@
+@ECHO OFF
+
+REM ========== COPYRIGHT/COPYLEFT ==========
+
+REM (C) 2016 Intel Deutschland GmbH
+REM Author: Michael Soegtrop
+
+REM Released to the public by Intel under the
+REM GNU Lesser General Public License Version 2.1 or later
+REM See https://www.gnu.org/licenses/old-licenses/lgpl-2.1.html
+
+REM ========== NOTES ==========
+
+REM For Cygwin setup command line options
+REM see https://cygwin.com/faq/faq.html#faq.setup.cli
+
+REM ========== DEFAULT VALUES FOR PARAMETERS ==========
+
+REM For a description of all parameters, see ReadMe.txt
+
+SET BATCHFILE=%0
+SET BATCHDIR=%~dp0
+
+REM see -arch in ReadMe.txt, but values are x86_64 or i686 (not 64 or 32)
+SET ARCH=x86_64
+
+REM see -mode in ReadMe.txt
+SET INSTALLMODE=absolute
+
+REM see -installer in ReadMe.txt
+SET MAKEINSTALLER=N
+
+REM see -ocaml in ReadMe.txt
+SET INSTALLOCAML=N
+
+REM see -make in ReadMe.txt
+SET INSTALLMAKE=Y
+
+REM see -destcyg in ReadMe.txt
+SET DESTCYG=C:\bin\cygwin_coq
+
+REM see -destcoq in ReadMe.txt
+SET DESTCOQ=C:\bin\coq
+
+REM see -setup in ReadMe.txt
+SET SETUP=setup-x86_64.exe
+
+REM see -proxy in ReadMe.txt
+IF DEFINED HTTP_PROXY (
+  SET PROXY="%HTTP_PROXY:http://=%"
+) else (
+  SET PROXY=""
+)
+
+REM see -cygrepo in ReadMe.txt
+SET CYGWIN_REPOSITORY=http://ftp.inf.tu-dresden.de/software/windows/cygwin32
+
+REM see -cygcache in ReadMe.txt
+SET CYGWIN_LOCAL_CACHE_WFMT=%BATCHDIR%cygwin_cache
+
+REM see -cyglocal in ReadMe.txt
+SET CYGWIN_FROM_CACHE=N
+
+REM see -cygquiet in ReadMe.txt
+SET CYGWIN_QUIET=Y
+
+REM see -srccache in ReadMe.txt
+SET SOURCE_LOCAL_CACHE_WFMT=%BATCHDIR%source_cache
+
+REM see -coqver in ReadMe.txt
+SET COQ_VERSION=8.5pl3
+
+REM see -gtksrc in ReadMe.txt
+SET GTK_FROM_SOURCES=N
+
+REM see -threads in ReadMe.txt
+SET MAKE_THREADS=8
+
+REM ========== PARSE COMMAND LINE PARAMETERS ==========
+
+SHIFT
+
+:Parse
+
+IF "%0" == "-arch" (
+  IF "%1" == "32" (
+    SET ARCH=i686
+    SET SETUP=setup-x86.exe
+  ) ELSE (
+    IF "%1" == "64" (
+      SET ARCH=x86_64
+      SET SETUP=setup-x86_64.exe
+    ) ELSE (
+      ECHO "Invalid -arch, valid are 32 and 64"
+      GOTO :EOF
+    )
+  )
+  SHIFT
+  SHIFT
+  GOTO Parse
+)
+
+IF "%0" == "-mode" (
+  IF "%1" == "mingwincygwin" (
+    SET INSTALLMODE=%1
+  ) ELSE (
+    IF "%1" == "absolute" (
+      SET INSTALLMODE=%1
+    ) ELSE (
+      IF "%1" == "relocatable" (
+        SET INSTALLMODE=%1
+      ) ELSE (
+        ECHO "Invalid -mode, valid are mingwincygwin, absolute and relocatable"
+        GOTO :EOF
+      )
+    )
+  )
+  SHIFT
+  SHIFT
+  GOTO Parse
+)
+
+IF "%0" == "-installer" (
+  SET MAKEINSTALLER=%1
+  SHIFT
+  SHIFT
+  GOTO Parse
+)
+
+IF "%0" == "-ocaml" (
+  SET INSTALLOCAML=%1
+  SHIFT
+  SHIFT
+  GOTO Parse
+)
+
+IF "%0" == "-make" (
+  SET INSTALLMAKE=%1
+  SHIFT
+  SHIFT
+  GOTO Parse
+)
+
+IF "%0" == "-destcyg" (
+  SET DESTCYG=%1
+  SHIFT
+  SHIFT
+  GOTO Parse
+)
+
+IF "%0" == "-destcoq" (
+  SET DESTCOQ=%1
+  SHIFT
+  SHIFT
+  GOTO Parse
+)
+
+IF "%0" == "-setup" (
+  SET SETUP=%1
+  SHIFT
+  SHIFT
+  GOTO Parse
+)
+
+IF "%0" == "-proxy" (
+  SET PROXY="%1"
+  SHIFT
+  SHIFT
+  GOTO Parse
+)
+
+IF "%0" == "-cygrepo" (
+  SET CYGWIN_REPOSITORY="%1"
+  SHIFT
+  SHIFT
+  GOTO Parse
+)
+
+IF "%0" == "-cygcache" (
+  SET CYGWIN_LOCAL_CACHE_WFMT="%1"
+  SHIFT
+  SHIFT
+  GOTO Parse
+)
+
+IF "%0" == "-cyglocal" (
+  SET CYGWIN_FROM_CACHE=%1
+  SHIFT
+  SHIFT
+  GOTO Parse
+)
+
+IF "%0" == "-cygquiet" (
+  SET CYGWIN_QUIET=%1
+  SHIFT
+  SHIFT
+  GOTO Parse
+)
+
+IF "%0" == "-srccache" (
+  SET SOURCE_LOCAL_CACHE_WFMT="%1"
+  SHIFT
+  SHIFT
+  GOTO Parse
+)
+
+IF "%0" == "-coqver" (
+  SET COQ_VERSION=%1
+  SHIFT
+  SHIFT
+  GOTO Parse
+)
+
+IF "%0" == "-gtksrc" (
+  SET GTK_FROM_SOURCES=%1
+  SHIFT
+  SHIFT
+  GOTO Parse
+)
+
+IF "%0" == "-threads" (
+  SET MAKE_THREADS=%1
+  SHIFT
+  SHIFT
+  GOTO Parse
+)
+
+IF NOT "%0" == "" (
+  ECHO Install cygwin and download, compile and install OCaml and Coq for MinGW
+  ECHO !!! Illegal parameter %0
+  ECHO Usage: 
+  ECHO MakeCoq_MinGW
+  CALL :PrintPars
+  goto :EOF
+)
+
+IF NOT EXIST %SETUP% (
+  ECHO The cygwin setup program %SETUP% doesn't exist. You must download it from https://cygwin.com/install.html.
+  GOTO :EOF
+)
+
+REM ========== ADJUST PARAMETERS ==========
+
+IF "%INSTALLMODE%" == "mingwincygwin" (
+  SET DESTCOQ=%DESTCYG%\usr\%ARCH%-w64-mingw32\sys-root\mingw
+)
+
+IF "%MAKEINSTALLER%" == "Y" (
+  SET INSTALLMODE=relocatable
+  SET INSTALLOCAML=Y
+  SET INSTALLMAKE=Y
+)
+
+REM ========== CONFIRM PARAMETERS ==========
+
+CALL :PrintPars
+REM Note: DOS batch replaces variables on parsing, so one can't use a variable just set in an () block
+IF "%COQREGTESTING%"=="Y" (GOTO :DontAsk)
+  SET /p ANSWER=Is this correct? y/n 
+  IF NOT "%ANSWER%"=="y" (GOTO :EOF)
+:DontAsk
+
+REM ========== DERIVED VARIABLES ==========
+
+SET CYGWIN_INSTALLDIR_WFMT=%DESTCYG%
+SET RESULT_INSTALLDIR_WFMT=%DESTCOQ%
+SET TARGET_ARCH=%ARCH%-w64-mingw32
+SET BASH=%CYGWIN_INSTALLDIR_WFMT%\bin\bash
+
+REM Convert pathes to various formats
+REM WFMT = windows format (C:\..)          Used in this batch file.
+REM CFMT = cygwin format (\cygdrive\c\..)  Used for Cygwin PATH varible, which is : separated, so C: doesn't work.
+REM MFMT = MinGW format (C:/...)           Used for the build, because \\ requires escaping. Mingw can handle \ and /.
+
+SET CYGWIN_INSTALLDIR_MFMT=%CYGWIN_INSTALLDIR_WFMT:\=/%
+SET RESULT_INSTALLDIR_MFMT=%RESULT_INSTALLDIR_WFMT:\=/%
+SET SOURCE_LOCAL_CACHE_MFMT=%SOURCE_LOCAL_CACHE_WFMT:\=/%
+
+SET CYGWIN_INSTALLDIR_CFMT=%CYGWIN_INSTALLDIR_MFMT:C:/=/cygdrive/c/%
+SET RESULT_INSTALLDIR_CFMT=%RESULT_INSTALLDIR_MFMT:C:/=/cygdrive/c/%
+SET SOURCE_LOCAL_CACHE_CFMT=%SOURCE_LOCAL_CACHE_MFMT:C:/=/cygdrive/c/%
+
+SET CYGWIN_INSTALLDIR_CFMT=%CYGWIN_INSTALLDIR_CFMT:D:/=/cygdrive/d/%
+SET RESULT_INSTALLDIR_CFMT=%RESULT_INSTALLDIR_CFMT:D:/=/cygdrive/d/%
+SET SOURCE_LOCAL_CACHE_CFMT=%SOURCE_LOCAL_CACHE_CFMT:D:/=/cygdrive/d/%
+
+SET CYGWIN_INSTALLDIR_CFMT=%CYGWIN_INSTALLDIR_CFMT:E:/=/cygdrive/e/%
+SET RESULT_INSTALLDIR_CFMT=%RESULT_INSTALLDIR_CFMT:E:/=/cygdrive/e/%
+SET SOURCE_LOCAL_CACHE_CFMT=%SOURCE_LOCAL_CACHE_CFMT:E:/=/cygdrive/e/%
+
+ECHO CYGWIN INSTALL DIR (WIN)    = %CYGWIN_INSTALLDIR_WFMT%
+ECHO CYGWIN INSTALL DIR (MINGW)  = %CYGWIN_INSTALLDIR_MFMT%
+ECHO CYGWIN INSTALL DIR (CYGWIN) = %CYGWIN_INSTALLDIR_CFMT%
+ECHO RESULT INSTALL DIR (WIN)    = %RESULT_INSTALLDIR_WFMT%
+ECHO RESULT INSTALL DIR (MINGW)  = %RESULT_INSTALLDIR_MFMT%
+ECHO RESULT INSTALL DIR (CYGWIN) = %RESULT_INSTALLDIR_CFMT%
+
+REM WARNING: Add a space after the = in case you want set this to empty, otherwise the variable will be unset
+SET MAKE_OPT=-j %MAKE_THREADS% 
+
+REM ========== DERIVED CYGWIN SETUP OPTIONS ==========
+
+REM WARNING: Add a space after the = otherwise the variable will be unset
+SET CYGWIN_OPT= 
+
+IF "%CYGWIN_FROM_CACHE%" == "Y" (
+  SET CYGWIN_OPT= %CYGWIN_OPT% -L
+)
+
+IF "%CYGWIN_QUIET%" == "Y" (
+  SET CYGWIN_OPT= %CYGWIN_OPT% -q --no-admin
+)
+
+IF "%GTK_FROM_SOURCES%"=="N" (
+  SET CYGWIN_OPT= %CYGWIN_OPT% -P mingw64-%ARCH%-gtk2.0,mingw64-%ARCH%-gtksourceview2.0
+)
+
+ECHO ========== INSTALL CYGWIN ==========
+
+REM Cygwin setup sets proper ACLs (permissions) for folders it CREATES.
+REM Otherwise chmod won't work and e.g. the ocaml build will fail.
+REM Cygwin setup does not touch the ACLs of existing folders.
+REM => Create the setup log in a temporary location and move it later.
+
+REM Get Unique temporary file name
+:logfileloop
+SET LOGFILE=%TEMP%\CygwinSetUp%RANDOM%-%RANDOM%-%RANDOM%-%RANDOM%.log
+if exist "%LOGFILE%" goto :logfileloop
+
+REM Run Cygwin Setup
+
+SET RUNSETUP=Y
+IF EXIST "%CYGWIN_INSTALLDIR_WFMT%\etc\setup\installed.db" (
+  SET RUNSETUP=N
+)
+IF NOT "%CYGWIN_QUIET%" == "Y" (
+  SET RUNSETUP=Y
+)
+
+IF "%RUNSETUP%"=="Y" (
+  %SETUP% ^
+    --proxy %PROXY% ^
+    --site %CYGWIN_REPOSITORY% ^
+    --root %CYGWIN_INSTALLDIR_WFMT% ^
+    --local-package-dir %CYGWIN_LOCAL_CACHE_WFMT% ^
+    --no-shortcuts ^
+    %CYGWIN_OPT% ^
+    -P wget,curl,git,make,unzip ^
+    -P gcc-core,gcc-g++ ^
+    -P gdb,liblzma5 ^
+    -P patch,automake1.14,automake1.15 ^
+    -P mingw64-%ARCH%-binutils,mingw64-%ARCH%-gcc-core,mingw64-%ARCH%-gcc-g++,mingw64-%ARCH%-pkg-config,mingw64-%ARCH%-windows_default_manifest ^
+    -P mingw64-%ARCH%-headers,mingw64-%ARCH%-runtime,mingw64-%ARCH%-pthreads,mingw64-%ARCH%-zlib ^
+    -P libiconv-devel,libunistring-devel,libncurses-devel ^
+    -P gettext-devel,libgettextpo-devel ^
+    -P libglib2.0-devel,libgdk_pixbuf2.0-devel ^
+    -P libfontconfig1 ^
+    -P gtk-update-icon-cache ^
+    -P libtool,automake ^
+    -P intltool ^
+    > "%LOGFILE%" ^
+    || GOTO :Error
+
+  MKDIR %CYGWIN_INSTALLDIR_WFMT%\build
+  MKDIR %CYGWIN_INSTALLDIR_WFMT%\build\buildlogs
+  MOVE  "%LOGFILE%" %CYGWIN_INSTALLDIR_WFMT%\build\buildlogs\cygwinsetup.log || GOTO :Error
+)
+
+
+IF NOT "%CYGWIN_QUIET%" == "Y" (
+  REM Like most setup programs, cygwin setup starts the real setup as a separate process, so wait for it.
+  REM This is not required with the -cygquiet=Y and the resulting --no-admin option.
+  :waitsetup
+  tasklist /fi "imagename eq %SETUP%" | find ":" > NUL
+  IF ERRORLEVEL 1 GOTO waitsetup
+)
+
+ECHO ========== CONFIGURE CYGWIN USER ACCOUNT ==========
+
+copy %BATCHDIR%\configure_profile.sh %CYGWIN_INSTALLDIR_WFMT%\var\tmp || GOTO :Error
+%BASH% --login %CYGWIN_INSTALLDIR_CFMT%\var\tmp\configure_profile.sh %PROXY% || GOTO :Error
+
+ECHO ========== BUILD COQ ==========
+
+MKDIR %CYGWIN_INSTALLDIR_WFMT%\build
+MKDIR %CYGWIN_INSTALLDIR_WFMT%\build\patches
+
+COPY %BATCHDIR%\makecoq_mingw.sh    %CYGWIN_INSTALLDIR_WFMT%\build || GOTO :Error
+COPY %BATCHDIR%\patches_coq\*.* %CYGWIN_INSTALLDIR_WFMT%\build\patches || GOTO :Error
+
+%BASH% --login %CYGWIN_INSTALLDIR_CFMT%\build\makecoq_mingw.sh || GOTO :Error
+
+ECHO ========== FINISHED ==========
+
+GOTO :EOF
+
+ECHO ========== BATCH FUNCTIONS ==========
+
+:PrintPars
+  REM  01234567890123456789012345678901234567890123456789012345678901234567890123456789
+  ECHO -arch     ^<i686 or x86_64^> Set cygwin, ocaml and coq to 32 or 64 bit
+  ECHO -mode     ^<mingwincygwin = install coq in default cygwin mingw sysroot^>
+  ECHO           ^<absoloute = install coq in -destcoq absulute path^>
+  ECHO           ^<relocatable = install relocatable coq in -destcoq path^>
+  ECHO -installer^<Y or N^> create a windows installer (will be in /build/coq/dev/nsis)
+  ECHO -ocaml    ^<Y or N^> install OCaml in Coq folder (Y) or just in cygwin folder (N)
+  ECHO -make     ^<Y or N^> install GNU Make in Coq folder (Y) or not (N)
+  ECHO -destcyg  ^<path to cygwin destination folder^>
+  ECHO -destcoq  ^<path to coq destination folder (mode=absoloute/relocatable)^>
+  ECHO -setup    ^<cygwin setup program name^> (auto adjusted to -arch)
+  ECHO -proxy    ^<internet proxy^>
+  ECHO -cygrepo  ^<cygwin download repository^>
+  ECHO -cygcache ^<local cygwin repository/cache^>
+  ECHO -cyglocal ^<Y or N^> install cygwin from cache 
+  ECHO -cygquiet ^<Y or N^> install cygwin without user interaction
+  ECHO -srccache ^<local source code repository/cache^>
+  ECHO -coqver   ^<Coq version to install^> 
+  ECHO -gtksrc   ^<Y or N^> build GTK ^(90 min^) or use cygwin version
+  ECHO -threads  ^<1..N^> Number of make threads
+  ECHO(
+  ECHO See ReadMe.txt for a detailed description of all parameters
+  ECHO(
+  ECHO Parameter values (default or currently set):
+  ECHO -arch     = %ARCH%
+  ECHO -mode     = %INSTALLMODE%
+  ECHO -ocaml    = %INSTALLOCAML%
+  ECHO -installer= %MAKEINSTALLER%
+  ECHO -make     = %INSTALLMAKE%
+  ECHO -destcyg  = %DESTCYG% 
+  ECHO -destcoq  = %DESTCOQ% 
+  ECHO -setup    = %SETUP% 
+  ECHO -proxy    = %PROXY%
+  ECHO -cygrepo  = %CYGWIN_REPOSITORY%
+  ECHO -cygcache = %CYGWIN_LOCAL_CACHE_WFMT%
+  ECHO -cyglocal = %CYGWIN_FROM_CACHE%
+  ECHO -cygquiet = %CYGWIN_QUIET%
+  ECHO -srccache = %SOURCE_LOCAL_CACHE_WFMT%
+  ECHO -coqver   = %COQ_VERSION%
+  ECHO -gtksrc   = %GTK_FROM_SOURCES%
+  ECHO -threads  = %MAKE_THREADS%
+  GOTO :EOF
+
+:Error
+ECHO Building Coq failed with error code %errorlevel%
+EXIT /b %errorlevel%
diff --git a/dev/build/windows/MakeCoq_SetRootPath.bat b/dev/build/windows/MakeCoq_SetRootPath.bat
new file mode 100644
index 000000000..3a3711724
--- /dev/null
+++ b/dev/build/windows/MakeCoq_SetRootPath.bat
@@ -0,0 +1,16 @@
+@ ECHO OFF
+
+REM Figure out a root path for coq and cygwin
+
+REM For the \nul trick for testing folders see
+REM https://support.microsoft.com/en-us/kb/65994
+
+IF EXIST D:\bin\nul (
+  SET ROOTPATH=D:\bin
+) else if EXIST C:\bin (
+  SET ROOTPATH=C:\bin
+) else (
+  SET ROOTPATH=C:
+)
+
+ECHO ROOTPATH set to %ROOTPATH%
diff --git a/dev/build/windows/MakeCoq_regtest_noproxy.bat b/dev/build/windows/MakeCoq_regtest_noproxy.bat
new file mode 100644
index 000000000..2b0b83fed
--- /dev/null
+++ b/dev/build/windows/MakeCoq_regtest_noproxy.bat
@@ -0,0 +1,18 @@
+call MakeCoq_SetRootPath

+

+SET HTTP_PROXY=

+EXPORT HTTP_PROXY=

+MKDIR C:\Temp\srccache

+

+call MakeCoq_MinGW.bat ^

+  -arch=64 ^

+  -mode=absolute ^

+  -ocaml=Y ^

+  -make=Y ^

+  -coqver 8.5pl2 ^

+  -srccache C:\Temp\srccache ^

+  -cygquiet=Y ^

+  -destcyg   %ROOTPATH%\cygwin_coq64_85pl2_abs ^

+  -destcoq   %ROOTPATH%\coq64_85pl2_abs

+
+pause
\ No newline at end of file
diff --git a/dev/build/windows/MakeCoq_regtests.bat b/dev/build/windows/MakeCoq_regtests.bat
new file mode 100644
index 000000000..6e36d0140
--- /dev/null
+++ b/dev/build/windows/MakeCoq_regtests.bat
@@ -0,0 +1,16 @@
+SET COQREGTESTING=Y
+
+REM Bleeding edge
+call MakeCoq_86git_abs_ocaml.bat
+call MakeCoq_86git_installer.bat
+call MakeCoq_86git_installer_32.bat
+call MakeCoq_86git_abs_ocaml_gtksrc.bat
+
+REM Current stable
+call MakeCoq_85pl3_abs_ocaml.bat
+call MakeCoq_85pl3_installer.bat
+call MakeCoq_85pl3_installer_32.bat
+
+REM Old but might still be used
+call MakeCoq_85pl2_abs_ocaml.bat
+call MakeCoq_84pl6_abs_ocaml.bat
diff --git a/dev/build/windows/ReadMe.txt b/dev/build/windows/ReadMe.txt
new file mode 100644
index 000000000..0faf5bc53
--- /dev/null
+++ b/dev/build/windows/ReadMe.txt
@@ -0,0 +1,460 @@
+==================== Purpose / Goal ====================
+
+The main purpose of these scripts is to build Coq for Windows in a reproducible
+and at least by this script documented way without using binary libraries and
+executables from various sources. These scripts use only MinGW libraries
+provided by Cygwin or compile things from sources. For some libraries there are
+options to build them from sources or to use the Cygwin version.
+
+Another goal (which is not yet achieved) is to have a Coq installer for
+Windows, which includes all tools required for native compute and Coq plugin
+development without Cygwin.
+
+Coq requires OCaml for this and OCaml requires binutils, gcc and a posix shell.
+Since the standard Windows OCaml installation requires Cygwin to deliver some of
+these components, you might be able to imagine that this is not so easy.
+
+These scripts can produce the following:
+
+- Coq running on MinGW
+
+- OCaml producing MinGW code and running on MinGW
+
+- GCC producing MinGW code and running on MinGW
+
+- binutils producing MinGW code and running on MinGW
+
+With "running on MinGW" I mean that the tools accept paths like
+"C:\myfolder\myfile.txt" and that they don't link to a Cygwin or msys DLL. The
+MinGW gcc and binutils provided by Cygwin produce MinGW code, but they run only
+on Cygwin.
+
+With "producing MinGW code" I mean that the programs created by the tools accept
+paths like "C:\myfolder\myfile.txt" and that they don't link to a Cygwin or msys
+DLL.
+
+The missing piece is a posix shell running on plain Windows (without msys or
+Cygwin DLL) and not beeing a binary from obscure sources. I am working on it ...
+
+Since compiling gcc and binutils takes a while and it is not of much use without
+a shell, the building of these components is currently disabled. OCaml is built
+anyway, because this MinGW/MinGW OCaml (rather than a Cygwin/MinGW OCaml) is
+used to compile Coq.
+
+Until the shell is there, the Cygwin created by these scripts is required to run
+OCaml tools. When everything is finished, this will no longer be required.
+
+==================== Usage ====================
+
+The Script MakeCoq_MinGW does:
+- download Cygwin (except the Setup.exe or Setup64.exe)
+- install Cygwin
+- either installs MinGW GTK via Cygwin or compiles it fom sources
+- download, compile and install OCaml, CamlP5, Menhir, lablgtk
+- download, compile and install Coq
+- create a Windows installer (NSIS based)
+
+The parameters are described below. Mostly paths and the HTTP proxy need to be
+set.
+
+There are two main usages:
+
+- Compile and install OCaml and Coq in a given folder
+
+  This works reliably, because absolute library paths can be compiled into Coq
+  and OCaml.
+  
+  WARNING: See the "Purpose / Goal" section above for status.
+  
+  See MakeCoq_85pl2_abs_ocaml.bat for parameters.
+
+- Create a Windows installer.
+
+  This works well for Coq but not so well for OCaml.
+
+  WARNING: See the "Purpose / Goal" section above for status.
+  
+  See MakeCoq_85pl2_installer.bat for parameters.
+
+There is also an option to compile OCaml and Coq inside Cygwin, but this is
+currently not recommended. The resulting Coq and OCaml work, but Coq is slow
+because it scans the largish Cygwin share folder. This will be fixed in a future
+version.
+
+Procedure:
+
+- Unzip contents of CoqSetup.zip in a folder
+
+- Adjust parameters in MakeCoq_85pl2_abs_ocaml.bat or in MakeCoq_85pl2_installer.bat.
+
+- Download Cygwin setup from https://Cygwin.com/install.html
+  For 32 bit Coq : setup-x86.exe    (https://Cygwin.com/setup-x86.exe)
+  For 64 bit Coq : setup-x86_64.exe (https://Cygwin.com/setup-x86_64.exe)
+
+- Run MakeCoq_85pl3_abs_ocaml.bat or MakeCoq_85pl3_installer.bat
+
+- Check MakeCoq_regtests.bat to see what combinations of options are tested
+
+==================== MakeCoq_MinGW Parameters ====================
+
+===== -arch =====
+
+Set the target architecture.
+
+Possible values:
+
+32: Install/build Cygwin, ocaml and coq for 32 bit windows
+
+64: Install/build Cygwin, ocaml and coq for 64 bit windows
+
+Default value: 64
+
+
+===== -mode =====
+
+Set the installation mode / target folder structure.
+  
+Possible values:
+
+mingwinCygwin: Install coq in the default Cygwin mingw sysroot folder.
+               This is %DESTCYG%\usr\%ARCH%-w64-mingw32\sys-root\mingw.
+               Todo: The coq share folder should be configured to e.g. /share/coq.
+               As is, coqc scans the complete share folder, which slows it down 5x for short files.
+               
+absoloute:     Install coq in the absolute path given with -destcoq.
+               The resulting Coq will not be relocatable.
+               That is the root folder must not be renamed/moved.
+
+relocatable:   Install coq in the absolute path given with -destcoq.
+               The resulting Coq will be relocatable.
+               That is the root folder may be renamed/moved.
+               If OCaml is installed, please note that OCaml cannot be build really relocatable.
+               If the root folder is moved, the environment variable OCAMLLIB must be set to the libocaml sub folder.
+               Also the file <root>\libocaml\ld.conf must be adjusted.
+
+Default value: absolute
+
+
+===== -installer =====
+
+Create a Windows installer (it will be in build/coq-8.xplx/dev/nsis)
+
+Possible values:
+
+Y: Create a windows installer - this forces -mode=relocatable.
+
+N: Don't create a windows installer - use the created Coq installation as is.
+
+Default value: N
+
+
+===== -ocaml =====
+
+Install OCaml for later use with Coq or just for building.
+
+Possible values:
+
+Y: Install OCaml in the same root as Coq (as given with -coqdest)
+   This also copies all .o, .cmo, .a, .cmxa files in the lib folder required for compiling plugins.
+
+N: Install OCaml in the default Cygwin mingw sysroot folder.
+   This is %DESTCYG%\usr\%ARCH%-w64-mingw32\sys-root\mingw.
+
+Default value: N
+
+
+===== -make =====
+
+Build and install MinGW GNU make
+
+Possible values:
+
+Y: Install MinGW GNU make in the same root as Coq (as given with -coqdest).
+
+N: Don't build or install MinGW GNU make.
+   For building everything always Cygwin GNU make is used.
+
+Default value: Y
+
+
+===== -destcyg =====
+
+Destination folder in which Cygwin is installed.
+
+This must be an absolute path in Windows format (with drive letter and \\).
+
+>>>>> This folder may be deleted after the Coq build is finished! <<<<<
+
+Default value: C:\bin\Cygwin_coq
+
+
+===== -destcoq =====
+
+Destination folder in which Coq is installed.
+
+This must be an absolute path in Windows format (with drive letter and \\).
+
+This option is not required if -mode mingwinCygwin is used.
+
+Default value: C:\bin\coq
+
+
+===== -setup =====
+
+Name/path of the Cygwin setup program.
+
+The Cygwin setup program is called setup-x86.exe or setup-x86_64.exe.
+It can be downloaded from: https://Cygwin.com/install.html.
+
+Default value: setup-x86.exe or setup-x86_64.exe, depending on -arch.
+
+
+===== -proxy =====
+
+Internet proxy setting for downloading Cygwin, ocaml and coq.
+
+The format is <server>:<port>, e.g. proxy.mycompany.com:911
+
+The same proxy is used for HTTP, HTTPS and FTP.
+If you need separate proxies for separate protocols, you please put your proxies directly into configure_profile.sh (line 11..13).
+
+Default value: Value of HTTP_PROXY environment variable or none if this variable does not exist.
+
+ATTENTION: With the --proxy setting of the Cygwin setup, it is possible to
+supply a proxy server, but if this parameter is "", Cygwin setup might use proxy
+settings from previous setups. If you once did a Cygwin setup behind a firewall
+and now want to do a Cygwin setup without a firewall, use the -cygquiet=N
+setting to perform a GUI install, where you can adjust the proxy setting.
+
+===== -cygrepo =====
+
+The online repository, from which Cygwin packages are downloaded.
+
+Note: although most repositories end with Cygwin32, they are good for 32 and 64 bit Cygwin.
+
+Default value: http://ftp.inf.tu-dresden.de/software/windows/Cygwin32
+
+>>>>> If you are not in Europe, you might want to change this! <<<<<
+
+
+===== -cygcache =====
+
+The local cache folder for Cygwin repositories.
+
+You can also copy files here from a backup/reference and set -cyglocal.
+The setup will then not download/update from the internet but only use the local cache.
+
+Default value: <folder of MakeCoq_MinGW.bat>\Cygwin_cache
+
+
+===== -cyglocal =====
+
+Control if the Cygwin setup uses the latest version from the internet or the version as is in the local folder.
+
+Possible values:
+
+Y: Install exactly the Cygwin version from the local repository cache.
+   Don't update from the internet.
+
+N: Download the latest Cygwin version from the internet.
+   Update the local repository cache with the latest version.
+
+Default value: N
+
+
+===== -cygquiet =====
+
+Control if the Cygwin setup runs quitely or interactive.
+
+Possible values:
+
+Y: Install Cygwin quitely without user interaction.
+
+N: Install Cygwin interactively (allows to select additional packages).
+
+Default value: Y
+
+
+===== -srccache =====
+
+The local cache folder for ocaml/coq/... sources.
+
+Default value: <folder of MakeCoq_MinGW.bat>\source_cache
+
+
+===== -coqver =====
+
+The version of Coq to download and compile.
+
+Possible values: 8.4pl6, 8.5pl2, 8.5pl3, git-v8.6 
+                 Others might work, but are untested.
+                 8.4 is only tested in mode=absoloute
+
+Default value: 8.5pl3
+
+If git- is prepended, the Coq sources are loaded from git.
+
+ATTENTION: with default options, the scripts cache source tar balls in two
+places, the <destination>/build/tarballs folder and the <scripts>/source_cache
+folder. If you modified something in git, you need to delete the cached tar ball
+in both places!
+
+===== -gtksrc =====
+
+Control if GTK and its prerequisites are build from sources or if binary MinGW packages from Cygwin are used
+
+Possible values:
+
+Y: Build GTK from sources, takes about 90 minutes extra.
+   This is useful, if you want to debug/fix GTK or library issues.
+
+N: Use prebuilt MinGW libraries from Cygwin
+
+
+===== -threads =====
+
+Control the maximum number of make threads for modules which support parallel make.
+
+Possible values: 1..N. 
+                 Should not be more than 1.5x the number of cores.
+                 Should not be more than available RAM/2GB (e.g. 4 for 8GB)
+
+
+==================== TODO ====================
+
+- Installer doesn't remove OCAMLLIB environment variables (it is in the script, but doesn't seem to work)
+- CoqIDE doesn't find theme files
+- Finish / test mingw_in_Cygwin mode (coqide doesn't start, coqc slow cause of scanning complete share folder)
+- Possibly create/login as specific user to bash (not sure if it makes sense - nead to create additional bash login link then)
+- maybe move share/doc/menhir somehwere else (reduces coqc startup time)
+- Use original installed file list for removing files in uninstaller 
+
+==================== Issues with relocation ====================
+
+Coq and OCaml are built in a specific folder and are not really intended for relocation e.g. by an installer.
+Some absolute paths in config files are patched in coq_new.nsi.
+
+Coq is made fairly relocatable by first configuring it with PREFIX=./ and then PREFIX=<installdir>.
+OCaml is made relocatable mostly by defining the OCAMLLIB environment variable and by patching some files.
+If you have issues with one of the remaining (unpatched) files below, please let me know.
+
+Text files patched by the installer:
+
+./ocamllib/ld.conf
+./etc/findlib.conf:destdir="D:\\bin\\coq64_buildtest_reloc_ocaml20\\libocaml\\site-lib"
+./etc/findlib.conf:path="D:\\bin\\coq64_buildtest_reloc_ocaml20\\libocaml\\site-lib"
+
+Text files containing the install folder path after install:
+
+./bin/mkcamlp5:LIB=D:/bin/coq64_buildtest_reloc_ocaml20/libocaml/camlp5
+./bin/mkcamlp5.opt:LIB=D:/bin/coq64_buildtest_reloc_ocaml20/libocaml/camlp5
+./libocaml/Makefile.config:PREFIX=D:/bin/coq64_buildtest_reloc_ocaml20
+./libocaml/Makefile.config:LIBDIR=D:/bin/coq64_buildtest_reloc_ocaml20/libocaml
+./libocaml/site-lib/findlib/Makefile.config:OCAML_CORE_BIN=/cygdrive/d/bin/coq64_buildtest_reloc_ocaml20/bin
+./libocaml/site-lib/findlib/Makefile.config:OCAML_SITELIB=D:/bin/coq64_buildtest_reloc_ocaml20\libocaml\site-lib
+./libocaml/site-lib/findlib/Makefile.config:OCAMLFIND_BIN=D:/bin/coq64_buildtest_reloc_ocaml20\bin
+./libocaml/site-lib/findlib/Makefile.config:OCAMLFIND_CONF=D:/bin/coq64_buildtest_reloc_ocaml20\etc\findlib.conf
+./libocaml/topfind:#directory "D:\\bin\\coq64_buildtest_reloc_ocaml20\\libocaml\\site-lib/findlib";;
+./libocaml/topfind:  Topdirs.dir_load Format.err_formatter "D:\\bin\\coq64_buildtest_reloc_ocaml20\\libocaml\\site-lib/findlib/findlib.cma";
+./libocaml/topfind:  Topdirs.dir_load Format.err_formatter "D:\\bin\\coq64_buildtest_reloc_ocaml20\\libocaml\\site-lib/findlib/findlib_top.cma";
+./libocaml/topfind:(* #load "D:\\bin\\coq64_buildtest_reloc_ocaml20\\libocaml\\site-lib/findlib/findlib.cma";; *)
+./libocaml/topfind:(* #load "D:\\bin\\coq64_buildtest_reloc_ocaml20\\libocaml\\site-lib/findlib/findlib_top.cma";; *)
+./man/man1/camlp5.1:These files are installed in the directory D:/bin/coq64_buildtest_reloc_ocaml20/libocaml/camlp5.
+./man/man1/camlp5.1:D:/bin/coq64_buildtest_reloc_ocaml20/libocaml/camlp5
+
+Binary files containing the build folder path after install:
+
+$ find . -type f -exec grep "Cygwin_coq64_buildtest_reloc_ocaml20" {} /dev/null \;
+Binary file ./bin/coqtop.byte.exe matches
+Binary file ./bin/coqtop.exe matches
+Binary file ./bin/ocamldoc.exe matches
+Binary file ./bin/ocamldoc.opt.exe matches
+Binary file ./libocaml/ocamldoc/odoc_info.a matches
+Binary file ./libocaml/ocamldoc/odoc_info.cma matches
+
+Binary files containing the install folder path after install:
+
+$ find . -type f -exec grep "coq64_buildtest_reloc_ocaml20" {} /dev/null \;
+Binary file ./bin/camlp4.exe matches
+Binary file ./bin/camlp4boot.exe matches
+Binary file ./bin/camlp4o.exe matches
+Binary file ./bin/camlp4o.opt.exe matches
+Binary file ./bin/camlp4of.exe matches
+Binary file ./bin/camlp4of.opt.exe matches
+Binary file ./bin/camlp4oof.exe matches
+Binary file ./bin/camlp4oof.opt.exe matches
+Binary file ./bin/camlp4orf.exe matches
+Binary file ./bin/camlp4orf.opt.exe matches
+Binary file ./bin/camlp4r.exe matches
+Binary file ./bin/camlp4r.opt.exe matches
+Binary file ./bin/camlp4rf.exe matches
+Binary file ./bin/camlp4rf.opt.exe matches
+Binary file ./bin/camlp5.exe matches
+Binary file ./bin/camlp5o.exe matches
+Binary file ./bin/camlp5o.opt matches
+Binary file ./bin/camlp5r.exe matches
+Binary file ./bin/camlp5r.opt matches
+Binary file ./bin/camlp5sch.exe matches
+Binary file ./bin/coqc.exe matches
+Binary file ./bin/coqchk.exe matches
+Binary file ./bin/coqdep.exe matches
+Binary file ./bin/coqdoc.exe matches
+Binary file ./bin/coqide.exe matches
+Binary file ./bin/coqmktop.exe matches
+Binary file ./bin/coqtop.byte.exe matches
+Binary file ./bin/coqtop.exe matches
+Binary file ./bin/coqworkmgr.exe matches
+Binary file ./bin/coq_makefile.exe matches
+Binary file ./bin/menhir matches
+Binary file ./bin/mkcamlp4.exe matches
+Binary file ./bin/ocaml.exe matches
+Binary file ./bin/ocamlbuild.byte.exe matches
+Binary file ./bin/ocamlbuild.exe matches
+Binary file ./bin/ocamlbuild.native.exe matches
+Binary file ./bin/ocamlc.exe matches
+Binary file ./bin/ocamlc.opt.exe matches
+Binary file ./bin/ocamldebug.exe matches
+Binary file ./bin/ocamldep.exe matches
+Binary file ./bin/ocamldep.opt.exe matches
+Binary file ./bin/ocamldoc.exe matches
+Binary file ./bin/ocamldoc.opt.exe matches
+Binary file ./bin/ocamlfind.exe matches
+Binary file ./bin/ocamlmklib.exe matches
+Binary file ./bin/ocamlmktop.exe matches
+Binary file ./bin/ocamlobjinfo.exe matches
+Binary file ./bin/ocamlopt.exe matches
+Binary file ./bin/ocamlopt.opt.exe matches
+Binary file ./bin/ocamlprof.exe matches
+Binary file ./bin/ocamlrun.exe matches
+Binary file ./bin/ocpp5.exe matches
+Binary file ./lib/config/coq_config.cmo matches
+Binary file ./lib/config/coq_config.o matches
+Binary file ./lib/grammar/grammar.cma matches
+Binary file ./lib/ide/ide_win32_stubs.o matches
+Binary file ./lib/lib/clib.a matches
+Binary file ./lib/lib/clib.cma matches
+Binary file ./lib/libcoqrun.a matches
+Binary file ./libocaml/camlp4/camlp4fulllib.a matches
+Binary file ./libocaml/camlp4/camlp4fulllib.cma matches
+Binary file ./libocaml/camlp4/camlp4lib.a matches
+Binary file ./libocaml/camlp4/camlp4lib.cma matches
+Binary file ./libocaml/camlp4/camlp4o.cma matches
+Binary file ./libocaml/camlp4/camlp4of.cma matches
+Binary file ./libocaml/camlp4/camlp4oof.cma matches
+Binary file ./libocaml/camlp4/camlp4orf.cma matches
+Binary file ./libocaml/camlp4/camlp4r.cma matches
+Binary file ./libocaml/camlp4/camlp4rf.cma matches
+Binary file ./libocaml/camlp5/odyl.cma matches
+Binary file ./libocaml/compiler-libs/ocamlcommon.a matches
+Binary file ./libocaml/compiler-libs/ocamlcommon.cma matches
+Binary file ./libocaml/dynlink.cma matches
+Binary file ./libocaml/expunge.exe matches
+Binary file ./libocaml/extract_crc.exe matches
+Binary file ./libocaml/libcamlrun.a matches
+Binary file ./libocaml/ocamlbuild/ocamlbuildlib.a matches
+Binary file ./libocaml/ocamlbuild/ocamlbuildlib.cma matches
+Binary file ./libocaml/ocamldoc/odoc_info.a matches
+Binary file ./libocaml/ocamldoc/odoc_info.cma matches
+Binary file ./libocaml/site-lib/findlib/findlib.a matches
+Binary file ./libocaml/site-lib/findlib/findlib.cma matches
+Binary file ./libocaml/site-lib/findlib/findlib.cmxs matches
diff --git a/dev/build/windows/configure_profile.sh b/dev/build/windows/configure_profile.sh
new file mode 100644
index 000000000..09a9cf35a
--- /dev/null
+++ b/dev/build/windows/configure_profile.sh
@@ -0,0 +1,32 @@
+#!/bin/bash
+
+rcfile=~/.bash_profile
+donefile=~/.bash_profile.upated
+
+if [ ! -f $donefile ] ; then
+
+    echo >> $rcfile
+    
+    if [ -n "$1" ]; then
+      echo export http_proxy="http://$1" >> $rcfile
+      echo export https_proxy="http://$1" >> $rcfile
+      echo export ftp_proxy="http://$1" >> $rcfile
+    fi
+    
+    mkdir -p $RESULT_INSTALLDIR_CFMT/bin
+
+    # A tightly controlled path helps to avoid issues
+    # Note: the order is important: first have the cygwin binaries, then the mingw binaries in the path!
+    # Note: /bin is mounted at /usr/bin and /lib at /usr/lib and it is common to use /usr/bin in PATH
+    # See cat /proc/mounts
+    echo "export PATH=/usr/local/bin:/usr/bin:$RESULT_INSTALLDIR_CFMT/bin:/usr/$TARGET_ARCH/sys-root/mingw/bin:/cygdrive/c/Windows/system32:/cygdrive/c/Windows" >> $rcfile
+
+    # find and xargs complain if the environment is larger than (I think) 8k.
+    # ORIGINAL_PATH (set by cygwin) can be a few k and exceed the limit
+    echo unset ORIGINAL_PATH >> $rcfile
+    
+    # Other installations of OCaml will mess up things
+    echo unset OCAMLLIB >> $rcfile
+
+    touch $donefile
+fi
\ No newline at end of file
diff --git a/dev/build/windows/difftar-folder.sh b/dev/build/windows/difftar-folder.sh
new file mode 100644
index 000000000..65278d5c9
--- /dev/null
+++ b/dev/build/windows/difftar-folder.sh
@@ -0,0 +1,86 @@
+#!/bin/bash
+
+###################### COPYRIGHT/COPYLEFT ######################
+
+# (C) 2016 Intel Deutschland GmbH
+# Author: Michael Soegtrop
+#
+# Released to the public by Intel under the
+# GNU Lesser General Public License Version 2.1 or later
+# See https://www.gnu.org/licenses/old-licenses/lgpl-2.1.html
+#
+# With very valuable help on building GTK from
+#   https://wiki.gnome.org/Projects/GTK+/Win32/MSVCCompilationOfGTKStack
+#   http://www.gaia-gis.it/spatialite-3.0.0-BETA/mingw64_how_to.html
+
+###################### Script safety and debugging settings ######################
+
+set -o nounset
+
+# Print usage
+
+if [ "$#" -lt 1 ] ; then
+  echo 'Diff a tar (or compressed tar) file with a folder'
+  echo 'difftar-folder.sh <tarfile> [<folder>] [strip]'
+  echo default for folder is .
+  echo default for strip is 0.
+  echo 'strip must be 0 or 1.'
+  exit 1
+fi
+
+# Parse parameters
+
+tarfile=$1
+
+if [ "$#" -ge 2 ] ; then
+  folder=$2
+else
+  folder=.
+fi
+
+if [ "$#" -ge 3 ] ; then
+  strip=$3
+else
+  strip=0
+fi
+
+# Get path prefix if --strip is used
+
+if [ "$strip" -gt 0 ] ; then
+  prefix=`tar -t -f $tarfile | head -1`
+else
+  prefix=
+fi
+
+# Original folder
+
+if [ "$strip" -gt 0 ] ; then
+  orig=${prefix%/}.orig
+elif [ "$folder" = "." ] ; then
+  orig=${tarfile##*/}
+  orig=./${orig%%.tar*}.orig
+elif [ "$folder" = "" ] ; then
+  orig=${tarfile##*/}
+  orig=${orig%%.tar*}.orig
+else
+  orig=$folder.orig
+fi
+echo $orig
+mkdir -p "$orig"
+
+
+# Make sure tar uses english output (for Mod time differs)
+export LC_ALL=C
+
+# Search all files with a deviating modification time using tar --diff
+tar --diff -a -f "$tarfile" --strip $strip --directory "$folder" | grep "Mod time differs" | while read -r file ; do
+  # Substitute ': Mod time differs' with nothing
+  file=${file/: Mod time differs/}
+  # Check if file exists
+  if [ -f "$folder/$file" ] ; then 
+    # Extract original file
+    tar -x -a -f "$tarfile" --strip $strip --directory "$orig" "$prefix$file"
+    # Compute diff
+    diff -u "$orig/$file" "$folder/$file" 
+  fi
+done
\ No newline at end of file
diff --git a/dev/build/windows/makecoq_mingw.sh b/dev/build/windows/makecoq_mingw.sh
new file mode 100644
index 000000000..52b158871
--- /dev/null
+++ b/dev/build/windows/makecoq_mingw.sh
@@ -0,0 +1,1270 @@
+#!/bin/bash
+
+###################### COPYRIGHT/COPYLEFT ######################
+
+# (C) 2016 Intel Deutschland GmbH
+# Author: Michael Soegtrop
+#
+# Released to the public by Intel under the
+# GNU Lesser General Public License Version 2.1 or later
+# See https://www.gnu.org/licenses/old-licenses/lgpl-2.1.html
+#
+# With very valuable help on building GTK from
+#   https://wiki.gnome.org/Projects/GTK+/Win32/MSVCCompilationOfGTKStack
+#   http://www.gaia-gis.it/spatialite-3.0.0-BETA/mingw64_how_to.html
+
+###################### Script safety and debugging settings ######################
+
+set -o nounset
+set -o errexit
+set -x
+
+# Set this to 1 if all module directories shall be removed before build (no incremental make)
+RMDIR_BEFORE_BUILD=1
+
+###################### NOTES #####################
+
+# - This file goes together with MakeCoq_ForMignGW.bat, which sets up cygwin
+#   with all required packages and then calls this script.
+#
+# - This script uses set -o errexit, so if anything fails, the script will stop
+#
+# - cygwin provided mingw64 packages like mingw64-x86_64-zlib are installed to
+#   /usr/$TARGET_ARCH/sys-root/mingw, so we use this as install prefix
+#
+# - if mingw64-x86_64-pkg-config is installed BEFORE building libpng or pixman,
+#   the .pc files are properly created in /usr/$TARGET_ARCH/sys-root/mingw/lib/pkgconfig
+#
+# - pango and some others uses pkg-config executable names without path, which doesn't work in cross compile mode
+#   There are several possible solutions
+#     1.) patch build files to get the prefix from pkg-config and use $prefix/bin/ as path
+#         - doesn't work for pango because automake goes wild
+#         - mingw tools are not able to handle cygwin path (they need absolute windows paths)
+#     2.) export PATH=$PATH:/usr/$TARGET_ARCH/sys-root/mingw/bin
+#         - a bit dangerous because this exposes much more than required
+#         - mingw tools are not able to handle cygwin path (they need absolute windows paths)
+#     3.) Install required tools via cygwin modules libglib2.0-devel and libgdk_pixbuf2.0-devel
+#         - Possibly version compatibility issues
+#         - Possibly mingw/cygwin compatibility issues, e.g. when building font or terminfo databases
+#     4.) Build required tools for mingw and cygwin
+#         - Possibly mingw/cygwin compatibility issues, e.g. when building font or terminfo databases
+#
+#   We use method 3 below
+#   Method 2 can be tried by putting the cross tools in the path before the cygwin tools (in configure_profile.sh)
+#
+# - It is tricky to build 64 bit binaries with 32 bit cross tools and vice versa.
+#   This is because the linker needs to load DLLs from C:\windows\system32, which contains
+#   both 32 bit and 64 bit DLLs, and which one you get depends by some black magic on if the using
+#   app is a 32 bit or 64 bit app. So better build 32 bit mingw with 32 bit cygwin and 64 with 64.
+#   Alternatively the required 32 bit or 64 bit DLLs need to be copied with a 32 bit/64bit cp to some
+#   folder without such black magic.
+#
+# - The file selection for the Coq Windows Installer is done with make install (unlike the original script)
+#   Relocatble builds are first configured with prefix=./ then build and then
+#   reconfigured with prefix=<installroot> before make install.
+
+
+###################### ARCHITECTURES #####################
+
+# The OS on which the build of the tool/lib runs
+BUILD=`gcc -dumpmachine`
+
+# The OS on which the tool runs
+# "`find /bin -name "*mingw32-gcc.exe"`" -dumpmachine
+HOST=$TARGET_ARCH
+
+# The OS for which the tool creates code/for which the libs are
+TARGET=$TARGET_ARCH
+
+# Cygwin uses different arch name for 32 bit than mingw/gcc
+case $ARCH in
+  x86_64) CYGWINARCH=x86_64 ;;
+  i686)   CYGWINARCH=x86 ;;
+  *)      false ;;
+esac
+
+###################### PATHS #####################
+
+# Name and create some 'global' folders
+PATCHES=/build/patches
+BUILDLOGS=/build/buildlogs
+FLAGFILES=/build/flagfiles
+TARBALLS=/build/tarballs
+FILELISTS=/build/filelists
+
+mkdir -p $BUILDLOGS
+mkdir -p $FLAGFILES
+mkdir -p $TARBALLS
+mkdir -p $FILELISTS
+cd /build
+
+
+# sysroot prefix for the above /build/host/target combination
+PREFIX=$CYGWIN_INSTALLDIR_MFMT/usr/$TARGET_ARCH/sys-root/mingw
+
+# Install / Prefix folder for COQ
+PREFIXCOQ=$RESULT_INSTALLDIR_MFMT
+
+# Install / Prefix folder for OCaml
+if [ "$INSTALLOCAML" == "Y" ]; then
+  PREFIXOCAML=$PREFIXCOQ
+else
+  PREFIXOCAML=$PREFIX
+fi
+
+mkdir -p $PREFIX/bin
+mkdir -p $PREFIXCOQ/bin
+mkdir -p $PREFIXOCAML/bin
+
+###################### Copy Cygwin Setup Info #####################
+
+# Copy Cygwin repo ini file and installed files db to tarballs folder.
+# Both files together document the exact selection and version of cygwin packages.
+# Do this as early as possible to avoid changes by other setups (the repo folder is shared).
+
+# Escape URL to folder name
+CYGWIN_REPO_FOLDER=${CYGWIN_REPOSITORY}/
+CYGWIN_REPO_FOLDER=${CYGWIN_REPO_FOLDER//:/%3a}
+CYGWIN_REPO_FOLDER=${CYGWIN_REPO_FOLDER//\//%2f}
+
+# Copy files
+cp $CYGWIN_LOCAL_CACHE_WFMT/$CYGWIN_REPO_FOLDER/$CYGWINARCH/setup.ini $TARBALLS
+cp /etc/setup/installed.db $TARBALLS
+  
+###################### LOGGING #####################
+
+# The folder which receives log files
+mkdir -p buildlogs
+LOGS=`pwd`/buildlogs
+
+# The current log target (first part of the log file name)
+LOGTARGET=other
+
+log1() {
+  "$@" > $LOGS/$LOGTARGET-$1.log 2> $LOGS/$LOGTARGET-$1.err
+}
+
+log2() {
+  "$@" > $LOGS/$LOGTARGET-$1-$2.log 2> $LOGS/$LOGTARGET-$1-$2.err
+}
+
+log_1_3() {
+  "$@" > $LOGS/$LOGTARGET-$1-$3.log 2> $LOGS/$LOGTARGET-$1-$3.err
+}
+
+logn() {
+  LOGTARGETEX=$1
+  shift
+  "$@" > $LOGS/$LOGTARGET-$LOGTARGETEX.log 2> $LOGS/$LOGTARGET-$LOGTARGETEX.err
+}
+ 
+###################### UTILITY FUNCTIONS #####################
+
+# ------------------------------------------------------------------------------
+# Get a source tar ball, expand and patch it
+# - get source archive from $SOURCE_LOCAL_CACHE_CFMT or online using wget
+# - create build folder
+# - extract source archive
+# - patch source file if patch exists
+# 
+# Parameters
+# $1 file server name including protocol prefix
+# $2 file name (without extension)
+# $3 file extension
+# $4 number of path levels to strip from tar (usually 1)
+# $5 module name (if different from archive)
+# $6 expand folder name (if different from module name)
+# ------------------------------------------------------------------------------
+
+function get_expand_source_tar {
+  # Handle optional parameters
+  if [ "$#" -ge 4 ] ; then
+    strip=$4
+  else
+    strip=1
+  fi
+
+  if [ "$#" -ge 5 ] ; then
+    name=$5
+  else
+    name=$2
+  fi
+  
+  if [ "$#" -ge 6 ] ; then
+    folder=$6
+  else
+    folder=$name
+  fi
+  
+  # Set logging target
+  logtargetold=$LOGTARGET
+  LOGTARGET=$name
+  
+  # Get the source archive either from the source cache or online
+  if [ ! -f $TARBALLS/$name.$3 ] ; then
+    if [ -f $SOURCE_LOCAL_CACHE_CFMT/$name.$3 ] ; then
+      cp $SOURCE_LOCAL_CACHE_CFMT/$name.$3 $TARBALLS
+    else
+      wget $1/$2.$3
+      if [ ! "$2.$3" == "$name.$3" ] ; then
+        mv $2.$3 $name.$3
+      fi
+      mv $name.$3 $TARBALLS
+      # Save the source archive in the source cache
+      if [ -d $SOURCE_LOCAL_CACHE_CFMT ] ; then
+        cp $TARBALLS/$name.$3 $SOURCE_LOCAL_CACHE_CFMT
+      fi
+    fi
+  fi
+  
+  # Remove build directory (clean build)
+  if [ $RMDIR_BEFORE_BUILD -eq 1 ] ; then
+    rm -f -r $folder
+  fi
+  
+  # Create build directory and cd
+  mkdir -p $folder
+  cd $folder
+  
+  # Extract source archive
+  if [ "$3" == "zip" ] ; then
+    log1 unzip $TARBALLS/$name.$3
+    if [ "$strip" == "1" ] ; then
+      # Ok, this is dirty, but it works and it fails if there are name clashes
+      mv */* .
+    else
+      echo "Unzip strip count not supported"
+      return 1
+    fi
+  else
+    logn untar tar xvaf $TARBALLS/$name.$3 --strip $strip
+  fi
+  
+  # Patch if patch file exists
+  if [ -f $PATCHES/$name.patch ] ; then
+    log1 patch -p1 -i $PATCHES/$name.patch
+  fi
+  
+  # Go back to base folder
+  cd ..
+
+  LOGTARGET=$logtargetold
+}
+
+# ------------------------------------------------------------------------------
+# Prepare a module build
+# - check if build is already done (name.finished file exists) - if so return 1
+# - create name.started
+# - get source archive from $SOURCE_LOCAL_CACHE_CFMT or online using wget
+# - create build folder
+# - cd to build folder and extract source archive
+# - create bin_special subfolder and add it to $PATH
+# - remember things for build_post
+# 
+# Parameters
+# $1 file server name including protocol prefix
+# $2 file name (without extension)
+# $3 file extension
+# $4 [optional] number of path levels to strip from tar (usually 1)
+# $5 [optional] module name (if different from archive)
+# ------------------------------------------------------------------------------
+
+function build_prep {
+  # Handle optional parameters
+  if [ "$#" -ge 4 ] ; then
+    strip=$4
+  else
+    strip=1
+  fi
+
+  if [ "$#" -ge 5 ] ; then
+    name=$5
+  else
+    name=$2
+  fi
+  
+  # Check if build is already done
+  if [ ! -f flagfiles/$name.finished ] ; then
+    BUILD_PACKAGE_NAME=$name
+    BUILD_OLDPATH=$PATH
+    BUILD_OLDPWD=`pwd`
+    LOGTARGET=$name
+
+    touch flagfiles/$name.started
+    
+    get_expand_source_tar $1 $2 $3 $strip $name
+    
+    cd $name
+    
+    # Create a folder and add it to path, where we can put special binaries
+    # The path is restored in build_post
+    mkdir bin_special
+    PATH=`pwd`/bin_special:$PATH
+    
+    return 0
+  else  
+    return 1
+  fi
+}
+
+# ------------------------------------------------------------------------------
+# Finalize a module build
+# - create name.finished
+# - go back to base folder
+# ------------------------------------------------------------------------------
+
+function build_post {
+  if [ ! -f flagfiles/$BUILD_PACKAGE_NAME.finished ]; then
+    cd $BUILD_OLDPWD
+    touch flagfiles/$BUILD_PACKAGE_NAME.finished
+    PATH=$BUILD_OLDPATH
+    LOGTARGET=other
+  fi
+}
+
+# ------------------------------------------------------------------------------
+# Build and install a module using the standard configure/make/make install process
+# - prepare build (as above)
+# - configure
+# - make
+# - make install
+# - finalize build (as above)
+#
+# parameters
+# $1 file server name including protocol prefix
+# $2 file name (without extension)
+# $3 file extension
+# $4 patch function to call between untar and configure (or true if none)
+# $5.. extra configure arguments
+# ------------------------------------------------------------------------------
+
+function build_conf_make_inst {
+  if build_prep $1 $2 $3 ; then
+    $4
+    logn configure ./configure --build=$BUILD --host=$HOST --target=$TARGET --prefix=$PREFIX "${@:5}"
+    log1 make $MAKE_OPT
+    log2 make install
+    log2 make clean
+    build_post
+  fi
+}
+
+# ------------------------------------------------------------------------------
+# Install all files given by a glob pattern to a given folder
+#
+# parameters
+# $1 glob pattern (in '')
+# $2 target folder
+# ------------------------------------------------------------------------------
+
+function install_glob {
+  # Check if any files matching the pattern exist
+  if [ "$(echo $1)" != "$1" ] ; then
+    install -D -t $2 $1
+  fi
+}
+
+
+# ------------------------------------------------------------------------------
+# Recursively Install all files given by a glob pattern to a given folder
+#
+# parameters
+# $1 source path
+# $2 pattern (in '')
+# $3 target folder
+# ------------------------------------------------------------------------------
+
+function install_rec {
+  ( cd $1 && find -type f -name "$2" -exec install -D -T  $1/{} $3/{} \; )
+}
+
+# ------------------------------------------------------------------------------
+# Write a file list of the target folder
+# The file lists are used to create file lists for the windows installer
+#
+# parameters
+# $1 name of file list
+# ------------------------------------------------------------------------------
+
+function list_files {
+  if [ ! -e "/build/filelists/$1" ] ; then
+    ( cd $PREFIXCOQ && find -type f | sort > /build/filelists/$1 )
+  fi
+}
+
+# ------------------------------------------------------------------------------
+# Compute the set difference of two file lists
+#
+# parameters
+# $1 name of list A-B (set difference of set A minus set B)
+# $2 name of list A
+# $3 name of list B
+# ------------------------------------------------------------------------------
+
+function diff_files {
+  # See http://www.catonmat.net/blog/set-operations-in-unix-shell/ for file list set operations
+  comm -23 <(sort "/build/filelists/$2") <(sort "/build/filelists/$3") > "/build/filelists/$1"
+}
+
+# ------------------------------------------------------------------------------
+# Filter a list of files with a regular expression
+#
+# parameters
+# $1 name of output file list
+# $2 name of input file list
+# $3 name of filter regexp
+# ------------------------------------------------------------------------------
+
+function filter_files {
+  egrep "$3" "/build/filelists/$2" > "/build/filelists/$1"
+}
+
+# ------------------------------------------------------------------------------
+# Convert a file list to NSIS installer format
+#
+# parameters
+# $1 name of file list file (output file is the same with extension .nsi)
+# ------------------------------------------------------------------------------
+
+function files_to_nsis {
+  # Split the path in the file list into path and filename and create SetOutPath and File instructions
+  # Note: File /oname cannot be used, because it does not create the paths as SetOutPath does
+  # Note: I didn't check if the redundant SetOutPath instructions have a bad impact on installer size or install time
+  cat "/build/filelists/$1" | tr '/' '\\' | sed -r 's/^\.(.*)\\([^\\]+)$/SetOutPath $INSTDIR\\\1\nFile ${COQ_SRC_PATH}\\\1\\\2/' > "/build/filelists/$1.nsh"
+}
+
+
+###################### MODULE BUILD FUNCTIONS #####################
+
+##### LIBPNG #####
+
+function make_libpng {
+  build_conf_make_inst  http://prdownloads.sourceforge.net/libpng  libpng-1.6.18  tar.gz  true
+}
+
+##### PIXMAN #####
+
+function make_pixman {
+  build_conf_make_inst  http://cairographics.org/releases  pixman-0.32.8  tar.gz  true
+}
+
+##### FREETYPE #####
+
+function make_freetype {
+  build_conf_make_inst  http://sourceforge.net/projects/freetype/files/freetype2/2.6.1  freetype-2.6.1  tar.bz2  true
+}
+
+##### EXPAT #####
+
+function make_expat {
+  build_conf_make_inst  http://sourceforge.net/projects/expat/files/expat/2.1.0  expat-2.1.0  tar.gz  true
+}
+
+##### FONTCONFIG #####
+
+function make_fontconfig {
+  make_freetype
+  make_expat
+  # CONFIGURE PARAMETERS
+  # build/install fails without --disable-docs 
+  build_conf_make_inst  http://www.freedesktop.org/software/fontconfig/release  fontconfig-2.11.94  tar.gz  true  --disable-docs
+}
+
+##### ICONV #####
+
+function make_libiconv {
+  build_conf_make_inst  http://ftp.gnu.org/pub/gnu/libiconv  libiconv-1.14  tar.gz  true
+}
+
+##### UNISTRING #####
+
+function make_libunistring {
+  build_conf_make_inst  http://ftp.gnu.org/gnu/libunistring  libunistring-0.9.5  tar.xz  true
+}
+
+##### NCURSES #####
+
+function make_ncurses {
+  # NOTE: ncurses is not required below. This is just kept for documentary purposes in case I need it later.
+  #
+  # NOTE: make install fails building the terminfo database because
+  # : ${TIC_PATH:=unknown} in run_tic.sh
+  # As a result pkg-config .pc files are not generated
+  # Also configure of gettext gives two "considers"
+  # checking where terminfo library functions come from... not found, consider installing GNU ncurses
+  # checking where termcap library functions come from... not found, consider installing GNU ncurses
+  # gettext make/make install work anyway
+  #
+  # CONFIGURE PARAMETERS
+  # --enable-term-driver --enable-sp-funcs is rewuired for mingw (see README.MinGW)
+  # additional changes 
+  # ADD --with-pkg-config
+  # ADD --enable-pc-files
+  # ADD --without-manpages
+  # REM --with-pthread
+  build_conf_make_inst  http://ftp.gnu.org/gnu/ncurses  ncurses-5.9  tar.gz  true  --disable-home-terminfo --enable-reentrant --enable-sp-funcs --enable-term-driver --enable-interop --with-pkg-config --enable-pc-files --without-manpages
+}
+
+##### GETTEXT #####
+
+function make_gettext {
+  # Cygwin packet dependencies: (not 100% sure) libiconv-devel,libunistring-devel,libncurses-devel
+  # Cygwin packet dependencies for gettext users: (not 100% sure) gettext-devel,libgettextpo-devel
+  # gettext configure complains that ncurses is also required, but it builds without it
+  # Ncurses is tricky to install/configure for mingw64, so I dropped ncurses
+  make_libiconv
+  make_libunistring
+  build_conf_make_inst  http://ftp.gnu.org/pub/gnu/gettext  gettext-0.19  tar.gz  true
+}
+
+##### LIBFFI #####
+
+function make_libffi {
+  # NOTE: The official download server is down  ftp://sourceware.org/pub/libffi/libffi-3.2.1.tar.gz
+  build_conf_make_inst  http://www.mirrorservice.org/sites/sourceware.org/pub/libffi  libffi-3.2.1  tar.gz  true
+}
+
+##### LIBEPOXY #####
+
+function make_libepoxy {
+  build_conf_make_inst  https://github.com/anholt/libepoxy/releases/download/v1.3.1  libepoxy-1.3.1  tar.bz2  true
+}
+
+##### LIBPCRE #####
+
+function make_libpcre {
+  build_conf_make_inst  ftp://ftp.csx.cam.ac.uk/pub/software/programming/pcre  pcre-8.39    tar.bz2  true
+}
+
+function make_libpcre2 {
+  build_conf_make_inst  ftp://ftp.csx.cam.ac.uk/pub/software/programming/pcre  pcre2-10.22  tar.bz2  true
+}
+
+##### GLIB #####
+
+function make_glib {
+  # Cygwin packet dependencies: mingw64-x86_64-zlib
+  make_gettext
+  make_libffi
+  make_libpcre
+  # build_conf_make_inst  http://ftp.gnome.org/pub/gnome/sources/glib/2.46  glib-2.46.0  tar.xz  true
+  build_conf_make_inst  http://ftp.gnome.org/pub/gnome/sources/glib/2.47  glib-2.47.5  tar.xz  true
+}
+
+##### ATK #####
+
+function make_atk {
+  make_gettext
+  make_glib
+  build_conf_make_inst  http://ftp.gnome.org/pub/gnome/sources/atk/2.18  atk-2.18.0  tar.xz  true
+}
+
+##### PIXBUF #####
+
+function make_gdk-pixbuf {
+  # Cygwin packet dependencies: mingw64-x86_64-zlib
+  make_libpng
+  make_gettext
+  make_glib
+  # CONFIGURE PARAMETERS
+  # --with-included-loaders=yes statically links the image file format handlers
+  # This avoids "Cannot open pixbuf loader module file '/usr/x86_64-w64-mingw32/sys-root/mingw/lib/gdk-pixbuf-2.0/2.10.0/loaders.cache': No such file or directory"
+  build_conf_make_inst  http://ftp.gnome.org/pub/GNOME/sources/gdk-pixbuf/2.32  gdk-pixbuf-2.32.1  tar.xz  true  --with-included-loaders=yes 
+}
+
+##### CAIRO #####
+
+function make_cairo {
+  # Cygwin packet dependencies: mingw64-x86_64-zlib
+  make_libpng
+  make_glib
+  make_pixman
+  make_fontconfig
+  build_conf_make_inst  http://cairographics.org/releases  cairo-1.14.2  tar.xz  true
+}
+
+##### PANGO #####
+
+function make_pango {
+  make_cairo
+  make_glib
+  make_fontconfig
+  build_conf_make_inst  http://ftp.gnome.org/pub/GNOME/sources/pango/1.38  pango-1.38.0  tar.xz  true
+}
+
+##### GTK2 #####
+
+function patch_gtk2 {
+  rm gtk/gtk.def
+}
+
+function make_gtk2 {
+  # Cygwin packet dependencies: gtk-update-icon-cache
+  if [ "$GTK_FROM_SOURCES" == "Y" ]; then
+    make_glib
+    make_atk
+    make_pango
+    make_gdk-pixbuf
+    make_cairo
+    build_conf_make_inst  http://ftp.gnome.org/pub/gnome/sources/gtk+/2.24  gtk+-2.24.28  tar.xz  patch_gtk2
+  fi
+}
+
+##### GTK3 #####
+
+function make_gtk3 {
+  make_glib
+  make_atk
+  make_pango
+  make_gdk-pixbuf
+  make_cairo
+  make_libepoxy
+  build_conf_make_inst  http://ftp.gnome.org/pub/gnome/sources/gtk+/3.16  gtk+-3.16.7  tar.xz  true
+
+  # make all incl. tests and examples runs through fine
+  # make install fails with issue with 
+  # 
+  # make[5]: Entering directory '/home/soegtrop/GTK/gtk+-3.16.7/demos/gtk-demo'
+  # test -n "" || ../../gtk/gtk-update-icon-cache --ignore-theme-index --force "/usr/x86_64-w64-mingw32/sys-root/mingw/share/icons/hicolor"
+  # gtk-update-icon-cache.exe: Failed to open file /usr/x86_64-w64-mingw32/sys-root/mingw/share/icons/hicolor/.icon-theme.cache : No such file or directory
+  # Makefile:1373: recipe for target 'install-update-icon-cache' failed
+  # make[5]: *** [install-update-icon-cache] Error 1
+  # make[5]: Leaving directory '/home/soegtrop/GTK/gtk+-3.16.7/demos/gtk-demo'
+}
+
+##### LIBXML2 #####
+
+function make_libxml2 {
+  # Cygwin packet dependencies: libtool automake
+  # Note: latest release version 2.9.2 fails during configuring lzma, so using 2.9.1
+  # Note: python binding requires <sys/select.h> which doesn't exist on cygwin
+  if build_prep https://git.gnome.org/browse/libxml2/snapshot  libxml2-2.9.1  tar.xz ; then
+    # ./autogen.sh --build=$BUILD --host=$HOST --target=$TARGET --prefix=$PREFIX --disable-shared --without-python
+    # shared library required by gtksourceview
+    ./autogen.sh --build=$BUILD --host=$HOST --target=$TARGET --prefix=$PREFIX --without-python
+    log1 make $MAKE_OPT all
+    log2 make install
+    log2 make clean
+    build_post
+  fi
+}
+
+##### GTK-SOURCEVIEW2 #####
+
+function make_gtk_sourceview2 {
+  # Cygwin packet dependencies: intltool
+  # gtksourceview-2.11.2 requires GTK2
+  # gtksourceview-2.91.9 requires GTK3
+  # => We use gtksourceview-2.11.2 which seems to be the newest GTK2 based one
+  if [ "$GTK_FROM_SOURCES" == "Y" ]; then
+    make_gtk2
+    make_libxml2
+    build_conf_make_inst  https://download.gnome.org/sources/gtksourceview/2.11  gtksourceview-2.11.2  tar.bz2  true
+  fi
+}
+
+##### FLEXDLL FLEXLINK #####
+
+# Note: there is a circular dependency between flexlink and ocaml (resolved in Ocaml 4.03.)
+# For MinGW it is not even possible to first build an Ocaml without flexlink support,
+# Because Makefile.nt doesn't support this. So we have to use a binary flexlink.
+# One could of cause do a bootstrap run ...
+
+# Install flexdll objects
+
+function install_flexdll {
+  cp flexdll.h /usr/$TARGET_ARCH/sys-root/mingw/include
+  if [ "$TARGET_ARCH" == "i686-w64-mingw32" ]; then
+    cp flexdll*_mingw.o /usr/$TARGET_ARCH/bin
+    cp flexdll*_mingw.o $PREFIXOCAML/bin
+  elif [ "$TARGET_ARCH" == "x86_64-w64-mingw32" ]; then
+    cp flexdll*_mingw64.o /usr/$TARGET_ARCH/bin
+    cp flexdll*_mingw64.o $PREFIXOCAML/bin
+  else
+    echo "Unknown target architecture"
+    return 1
+  fi
+}
+
+# Install flexlink
+
+function install_flexlink {
+  cp flexlink.exe /usr/$TARGET_ARCH/bin
+    
+  cp flexlink.exe $PREFIXOCAML/bin
+}
+
+# Get binary flexdll flexlink for building OCaml
+# An alternative is to first build an OCaml without shared library support and build flexlink with it
+
+function get_flex_dll_link_bin {
+  if build_prep http://alain.frisch.fr/flexdll flexdll-bin-0.34 zip 1 ; then
+    install_flexdll
+    install_flexlink
+    build_post
+  fi
+}
+
+# Build flexdll and flexlink from sources after building OCaml
+
+function make_flex_dll_link {
+  if build_prep http://alain.frisch.fr/flexdll flexdll-0.34 tar.gz ; then
+    if [ "$TARGET_ARCH" == "i686-w64-mingw32" ]; then
+      log1 make $MAKE_OPT build_mingw flexlink.exe
+    elif [ "$TARGET_ARCH" == "x86_64-w64-mingw32" ]; then
+      log1 make $MAKE_OPT build_mingw64 flexlink.exe
+    else
+      echo "Unknown target architecture"
+      return 1
+    fi
+    install_flexdll
+    install_flexlink
+    log2 make clean
+    build_post
+  fi
+}
+
+##### LN replacement #####
+
+# Note: this does support symlinks, but symlinks require special user rights on Windows.
+# ocamlbuild uses symlinks to link the executables in the build folder to the base folder.
+# For this purpose hard links are better.
+
+function make_ln {
+  if [ ! -f flagfiles/myln.finished ] ; then
+    touch flagfiles/myln.started
+    mkdir -p myln
+    cd myln
+    cp $PATCHES/ln.c .
+    $TARGET_ARCH-gcc -DUNICODE -D_UNICODE -DIGNORE_SYMBOLIC -mconsole -o ln.exe ln.c 
+    install -D ln.exe $PREFIXCOQ/bin/ln.exe
+    cd ..
+    touch flagfiles/myln.finished
+  fi
+}
+
+##### OCAML #####
+
+function make_ocaml {
+  get_flex_dll_link_bin
+  if build_prep http://caml.inria.fr/pub/distrib/ocaml-4.02 ocaml-4.02.3 tar.gz 1 ; then
+  # if build_prep http://caml.inria.fr/pub/distrib/ocaml-4.01 ocaml-4.01.0 tar.gz 1 ; then
+    # See README.win32
+    cp config/m-nt.h config/m.h
+    cp config/s-nt.h config/s.h
+    if [ "$TARGET_ARCH" == "i686-w64-mingw32" ]; then
+        cp config/Makefile.mingw config/Makefile
+    elif [ "$TARGET_ARCH" == "x86_64-w64-mingw32" ]; then
+        cp config/Makefile.mingw64 config/Makefile
+    else
+        echo "Unknown target architecture"
+        return 1
+    fi
+
+    # Prefix is fixed in make file - replace it with the real one
+    sed -i "s|^PREFIX=.*|PREFIX=$PREFIXOCAML|" config/Makefile
+    
+    # We don't want to mess up Coq's dirctory structure so put the OCaml library in a separate folder
+    # If we refer to the make variable ${PREFIX} below, camlp4 ends up having a wrong path:
+    # D:\bin\coq64_buildtest_abs_ocaml4\bin>ocamlc -where => D:/bin/coq64_buildtest_abs_ocaml4/libocaml
+    # D:\bin\coq64_buildtest_abs_ocaml4\bin>camlp4 -where => ${PREFIX}/libocaml\camlp4
+    # So we put an explicit path in there
+    sed -i "s|^LIBDIR=.*|LIBDIR=$PREFIXOCAML/libocaml|" config/Makefile
+    
+    # Note: ocaml doesn't support -j 8, so don't pass MAKE_OPT
+    # I verified that 4.02.3 still doesn't support parallel build
+    log2 make world -f Makefile.nt
+    log2 make bootstrap -f Makefile.nt
+    log2 make opt -f Makefile.nt
+    log2 make opt.opt -f Makefile.nt
+    log2 make install -f Makefile.nt
+    # TODO log2 make clean -f Makefile.nt Temporarily disabled for ocamlbuild development
+    
+    # Move license files and other into into special folder
+    if [ "$INSTALLMODE" == "absolute" ] || [ "$INSTALLMODE" == "relocatable" ]; then
+      mkdir -p $PREFIXOCAML/license_readme/ocaml
+      # 4.01 installs these files, 4.02 doesn't. So delete them and copy them from the sources.
+      rm -f *.txt
+      cp LICENSE      $PREFIXOCAML/license_readme/ocaml/License.txt
+      cp INSTALL      $PREFIXOCAML/license_readme/ocaml/Install.txt
+      cp README       $PREFIXOCAML/license_readme/ocaml/ReadMe.txt
+      cp README.win32 $PREFIXOCAML/license_readme/ocaml/ReadMeWin32.txt
+      cp VERSION      $PREFIXOCAML/license_readme/ocaml/Version.txt
+      cp Changes      $PREFIXOCAML/license_readme/ocaml/Changes.txt
+    fi
+
+    build_post
+  fi
+  make_flex_dll_link
+}
+
+##### FINDLIB Ocaml library manager #####
+
+function make_findlib {
+  make_ocaml
+  if build_prep http://download.camlcity.org/download findlib-1.5.6 tar.gz 1 ; then
+    ./configure -bindir $PREFIXOCAML\\bin -sitelib $PREFIXOCAML\\libocaml\\site-lib -config $PREFIXOCAML\\etc\\findlib.conf
+    # Note: findlib doesn't support -j 8, so don't pass MAKE_OPT
+    log2 make all
+    log2 make opt
+    log2 make install
+    log2 make clean
+    build_post
+  fi
+}
+
+##### MENHIR Ocaml Parser Generator #####
+
+function make_menhir {
+  make_ocaml
+  make_findlib
+  # if build_prep http://gallium.inria.fr/~fpottier/menhir menhir-20151112 tar.gz 1 ; then
+  # For Ocaml 4.02
+  # if build_prep http://gallium.inria.fr/~fpottier/menhir menhir-20151012 tar.gz 1 ; then
+  # For Ocaml 4.01
+  if build_prep http://gallium.inria.fr/~fpottier/menhir menhir-20140422 tar.gz 1 ; then
+    # Note: menhir doesn't support -j 8, so don't pass MAKE_OPT
+    log2 make all PREFIX=$PREFIXOCAML
+    log2 make install PREFIX=$PREFIXOCAML
+    mv $PREFIXOCAML/bin/menhir $PREFIXOCAML/bin/menhir.exe
+    build_post
+  fi
+}
+
+##### CAMLP4 Ocaml Preprocessor #####
+
+function make_camlp4 {
+  # OCaml up to 4.01 includes camlp4, from 4.02 it isn't included
+  # Check if command camlp4 exists, if not build camlp4
+  if ! command camlp4 ; then
+    make_ocaml
+    make_findlib
+    if build_prep https://github.com/ocaml/camlp4/archive 4.02+6 tar.gz 1 camlp4-4.02+6 ; then
+      # See https://github.com/ocaml/camlp4/issues/41#issuecomment-112018910
+      logn configure ./configure
+      # Note: camlp4 doesn't support -j 8, so don't pass MAKE_OPT
+      log2 make all
+      log2 make install
+      log2 make clean
+      build_post
+    fi
+  fi
+}
+
+##### CAMLP5 Ocaml Preprocessor #####
+
+function make_camlp5 {
+  make_ocaml
+  make_findlib
+  if build_prep http://camlp5.gforge.inria.fr/distrib/src camlp5-6.14 tgz 1 ; then
+    logn configure ./configure 
+    # Somehow my virus scanner has the boot.new/SAVED directory locked after the move for a second => repeat until success
+    sed -i 's/mv boot.new boot/until mv boot.new boot; do sleep 1; done/' Makefile
+    log1 make world.opt $MAKE_OPT
+    log2 make install
+    # For some reason gramlib.a is not copied, but it is required by Coq
+    cp lib/gramlib.a $PREFIXOCAML/libocaml/camlp5/
+    log2 make clean
+    build_post
+  fi
+}
+
+##### LABLGTK Ocaml GTK binding #####
+
+# Note: when rebuilding lablgtk by deleting the .finished file,
+# also delete <root>\usr\x86_64-w64-mingw32\sys-root\mingw\lib\site-lib
+# Otherwise make install fails
+
+function make_lablgtk {
+  make_ocaml
+  make_findlib
+  make_camlp4
+  if build_prep https://forge.ocamlcore.org/frs/download.php/1479 lablgtk-2.18.3 tar.gz 1 ; then
+    # configure should be fixed to search for $TARGET_ARCH-pkg-config.exe
+    cp /bin/$TARGET_ARCH-pkg-config.exe  bin_special/pkg-config.exe
+    logn configure ./configure --build=$BUILD --host=$HOST --target=$TARGET --prefix=$PREFIXOCAML
+    
+    # lablgtk shows occasional errors with -j, so don't pass $MAKE_OPT
+    
+    # See https://sympa.inria.fr/sympa/arc/caml-list/2015-10/msg00204.html for the make || true + strip
+    logn make-world-pre make world || true
+    $TARGET_ARCH-strip.exe --strip-unneeded src/dlllablgtk2.dll
+    
+    log2 make world
+    log2 make install
+    log2 make clean
+    build_post
+  fi
+}
+
+##### Ocaml Stdint #####
+
+function make_stdint {
+  make_ocaml
+  make_findlib
+  if build_prep https://github.com/andrenth/ocaml-stdint/archive 0.3.0 tar.gz 1 Stdint-0.3.0; then
+    # Note: the setup gets the proper install path from ocamlfind, but for whatever reason it wants
+    # to create an empty folder in some folder which defaults to C:\Program Files.
+    # The --preifx overrides this. Id didn't see any files created in /tmp/extra.
+    log_1_3 ocaml setup.ml -configure --prefix /tmp/extra
+    log_1_3 ocaml setup.ml -build
+    log_1_3 ocaml setup.ml -install
+    log_1_3 ocaml setup.ml -clean
+    build_post
+  fi
+}
+
+##### COQ #####
+
+# Copy one DLLfrom cygwin MINGW packages to Coq install folder
+
+function copy_coq_dll {
+  if [ "$INSTALLMODE" == "absolute" ] || [ "$INSTALLMODE" == "relocatable" ]; then
+    cp /usr/${ARCH}-w64-mingw32/sys-root/mingw/bin/$1 $PREFIXCOQ/bin/$1
+  fi
+}
+
+# Copy required DLLs from cygwin MINGW packages to Coq install folder
+
+function copy_coq_dlls {
+  # HOW TO CREATE THE DLL LIST
+  # With the list empty, after the build/install is finished, open coqide in dependency walker.
+  # See http://www.dependencywalker.com/
+  # Make sure to use the 32 bit / 64 bit version of depends matching the target architecture.
+  # Select all missing DLLs from the module list, right click "copy filenames"
+  # Delay loaded DLLs from Windows can be ignored (hour-glass icon at begin of line)
+  # Do this recursively until there are no further missing DLLs (File close + reopen)
+  # For running this quickly, just do "cd coq-<ver> ; call copy_coq_dlls ; cd .." at the end of this script.
+  # Do the same for coqc and ocamlc (usually doesn't result in additional files)
+  
+  copy_coq_dll LIBATK-1.0-0.DLL
+  copy_coq_dll LIBCAIRO-2.DLL
+  copy_coq_dll LIBEXPAT-1.DLL
+  copy_coq_dll LIBFFI-6.DLL
+  copy_coq_dll LIBFONTCONFIG-1.DLL
+  copy_coq_dll LIBFREETYPE-6.DLL
+  copy_coq_dll LIBGDK-WIN32-2.0-0.DLL
+  copy_coq_dll LIBGDK_PIXBUF-2.0-0.DLL
+  copy_coq_dll LIBGIO-2.0-0.DLL
+  copy_coq_dll LIBGLIB-2.0-0.DLL
+  copy_coq_dll LIBGMODULE-2.0-0.DLL
+  copy_coq_dll LIBGOBJECT-2.0-0.DLL
+  copy_coq_dll LIBGTK-WIN32-2.0-0.DLL
+  copy_coq_dll LIBINTL-8.DLL
+  copy_coq_dll LIBPANGO-1.0-0.DLL
+  copy_coq_dll LIBPANGOCAIRO-1.0-0.DLL
+  copy_coq_dll LIBPANGOWIN32-1.0-0.DLL
+  copy_coq_dll LIBPIXMAN-1-0.DLL
+  copy_coq_dll LIBPNG16-16.DLL
+  copy_coq_dll LIBXML2-2.DLL
+  copy_coq_dll ZLIB1.DLL
+
+  # Depends on if GTK is built from sources  
+  if [ "$GTK_FROM_SOURCES" == "Y" ]; then
+    copy_coq_dll libiconv-2.dll
+    copy_coq_dll libpcre-1.dll
+  else
+    copy_coq_dll ICONV.DLL
+    copy_coq_dll LIBBZ2-1.DLL
+    copy_coq_dll LIBGTKSOURCEVIEW-2.0-0.DLL
+    copy_coq_dll LIBHARFBUZZ-0.DLL
+    copy_coq_dll LIBLZMA-5.DLL
+    copy_coq_dll LIBPANGOFT2-1.0-0.DLL
+  fi;
+
+  # Architecture dependent files
+  case $ARCH in
+    x86_64) copy_coq_dll LIBGCC_S_SEH-1.DLL ;;
+    i686)   copy_coq_dll LIBGCC_S_SJLJ-1.DLL ;;
+    *)      false ;;
+  esac
+  
+  # Win pthread version change
+  copy_coq_dll LIBWINPTHREAD-1.DLL
+}
+
+function copy_coq_objects {
+  # copy objects only from folders which exist in the target lib directory
+  find . -type d | while read FOLDER ; do
+    if [ -e $PREFIXCOQ/lib/$FOLDER ] ; then
+      install_glob $FOLDER/'*.cmxa' $PREFIXCOQ/lib/$FOLDER 
+      install_glob $FOLDER/'*.cmi'  $PREFIXCOQ/lib/$FOLDER 
+      install_glob $FOLDER/'*.cma'  $PREFIXCOQ/lib/$FOLDER 
+      install_glob $FOLDER/'*.cmo'  $PREFIXCOQ/lib/$FOLDER 
+      install_glob $FOLDER/'*.a'    $PREFIXCOQ/lib/$FOLDER 
+      install_glob $FOLDER/'*.o'    $PREFIXCOQ/lib/$FOLDER 
+    fi
+  done
+}
+
+# Copy required GTK config and suport files
+
+function copq_coq_gtk {
+  echo 'gtk-theme-name = "MS-Windows"'     >  $PREFIX/etc/gtk-2.0/gtkrc
+  echo 'gtk-fallback-icon-theme = "Tango"' >> $PREFIX/etc/gtk-2.0/gtkrc
+
+  if [ "$INSTALLMODE" == "absolute" ] || [ "$INSTALLMODE" == "relocatable" ]; then
+    install_glob $PREFIX/etc/gtk-2.0/'*'                            $PREFIXCOQ/gtk-2.0
+    install_glob $PREFIX/share/gtksourceview-2.0/language-specs/'*' $PREFIXCOQ/share/gtksourceview-2.0/language-specs
+    install_glob $PREFIX/share/gtksourceview-2.0/styles/'*'         $PREFIXCOQ/share/gtksourceview-2.0/styles
+    install_rec  $PREFIX/share/themes/ '*'                          $PREFIXCOQ/share/themes
+    
+    # This below item look like a bug in make install
+    if [[ ! $COQ_VERSION == 8.4* ]] ; then
+      mv $PREFIXCOQ/share/coq/*.lang $PREFIXCOQ/share/gtksourceview-2.0/language-specs
+      mv $PREFIXCOQ/share/coq/*.xml  $PREFIXCOQ/share/gtksourceview-2.0/styles
+    fi
+    mkdir -p $PREFIXCOQ/ide
+    mv $PREFIXCOQ/share/coq/*.png  $PREFIXCOQ/ide
+    rmdir $PREFIXCOQ/share/coq
+  fi
+}
+
+# Copy license and other info files
+
+function copy_coq_license {
+  if [ "$INSTALLMODE" == "absolute" ] || [ "$INSTALLMODE" == "relocatable" ]; then
+    install -D doc/LICENSE                    $PREFIXCOQ/license_readme/coq/LicenseDoc.txt
+    install -D LICENSE                        $PREFIXCOQ/license_readme/coq/License.txt
+    install -D plugins/micromega/LICENSE.sos  $PREFIXCOQ/license_readme/coq/LicenseMicromega.txt
+    install -D README                         $PREFIXCOQ/license_readme/coq/ReadMe.txt || true
+    install -D README.md                      $PREFIXCOQ/license_readme/coq/ReadMe.md || true
+    install -D README.doc                     $PREFIXCOQ/license_readme/coq/ReadMeDoc.txt
+    install -D CHANGES                        $PREFIXCOQ/license_readme/coq/Changes.txt
+    install -D INSTALL                        $PREFIXCOQ/license_readme/coq/Install.txt
+    install -D INSTALL.doc                    $PREFIXCOQ/license_readme/coq/InstallDoc.txt
+    install -D INSTALL.ide                    $PREFIXCOQ/license_readme/coq/InstallIde.txt
+  fi
+}
+
+# Main function for creating Coq
+
+function make_coq {
+  make_ocaml
+  make_lablgtk
+  make_camlp5
+  if 
+    case $COQ_VERSION in
+      git-*) build_prep https://github.com/coq/coq/archive ${COQ_VERSION##git-} zip 1 coq-${COQ_VERSION} ;;
+      *)     build_prep https://coq.inria.fr/distrib/V$COQ_VERSION/files coq-$COQ_VERSION tar.gz ;;
+    esac
+  then
+    if [ "$INSTALLMODE" == "relocatable" ]; then
+      # HACK: for relocatable builds, first configure with ./, then build but before install reconfigure with the real target path
+      logn configure ./configure -debug -with-doc no -prefix ./ -libdir ./lib -mandir ./man
+    elif [ "$INSTALLMODE" == "absolute" ]; then
+      logn configure ./configure -debug -with-doc no -prefix $PREFIXCOQ -libdir $PREFIXCOQ/lib -mandir $PREFIXCOQ/man
+    else
+      logn configure ./configure -debug -with-doc no -prefix $PREFIXCOQ
+    fi
+
+    # The windows resource compiler binary name is hard coded
+    sed -i "s/i686-w64-mingw32-windres/$TARGET_ARCH-windres/" Makefile.build 
+    sed -i "s/i686-w64-mingw32-windres/$TARGET_ARCH-windres/" Makefile.ide || true
+
+    # 8.4x doesn't support parallel make
+    if [[ $COQ_VERSION == 8.4* ]] ; then
+      log1 make
+    else
+      log1 make $MAKE_OPT
+    fi
+    
+    if [ "$INSTALLMODE" == "relocatable" ]; then
+      ./configure -debug -with-doc no -prefix $PREFIXCOQ -libdir $PREFIXCOQ/lib -mandir $PREFIXCOQ/man
+    fi
+
+    log2 make install
+    log1 copy_coq_dlls
+    if [ "$INSTALLOCAML" == "Y" ]; then
+      log1 copy_coq_objects
+    fi
+    
+    copq_coq_gtk
+    copy_coq_license
+
+    # make clean seems to br broken for 8.5pl2
+    # 1.) find | xargs fails on cygwin, can be fixed by sed -i 's|\| xargs rm -f|-exec rm -fv \{\} \+|' Makefile
+    # 2.) clean of test suites fails with "cannot run complexity tests (no bogomips found)"
+    # make clean
+    
+    build_post
+  fi
+}
+
+##### GNU Make for MinGW #####
+
+function make_mingw_make {
+  if build_prep http://ftp.gnu.org/gnu/make make-4.2 tar.bz2 ; then
+    # The config.h.win32 file is fine - don't edit it
+    # We need to copy the mingw gcc here as "gcc" - then the batch file will use it
+    cp /usr/bin/${ARCH}-w64-mingw32-gcc-5.4.0.exe ./gcc.exe
+    # By some magic cygwin bash can run batch files
+    logn build ./build_w32.bat gcc
+    # Copy make to Coq folder
+    cp GccRel/gnumake.exe $PREFIXCOQ/bin/make.exe
+    build_post
+  fi
+}
+
+##### GNU binutils for native OCaml #####
+
+function make_binutils {
+  if build_prep http://ftp.gnu.org/gnu/binutils binutils-2.27 tar.gz ; then
+    logn configure ./configure --build=$BUILD --host=$HOST --target=$TARGET --prefix=$PREFIXCOQ --program-prefix=$TARGET-
+    log1 make $MAKE_OPT
+    log2 make install
+    # log2 make clean
+    build_post
+  fi
+}
+
+##### GNU GCC for native OCaml #####
+
+function make_gcc {
+  # Note: the bz2 file is smaller, but decompressing bz2 really takes ages
+  if build_prep ftp://ftp.fu-berlin.de/unix/languages/gcc/releases/gcc-5.4.0 gcc-5.4.0 tar.gz ; then
+    # This is equivalent to "contrib/download_prerequisites" but uses caching
+    # Update versions when updating gcc version
+    get_expand_source_tar  ftp://gcc.gnu.org/pub/gcc/infrastructure  mpfr-2.4.2 tar.bz2 1 mpfr-2.4.2 mpfr
+    get_expand_source_tar  ftp://gcc.gnu.org/pub/gcc/infrastructure  gmp-4.3.2  tar.bz2 1 gmp-4.3.2  gmp
+    get_expand_source_tar  ftp://gcc.gnu.org/pub/gcc/infrastructure  mpc-0.8.1  tar.gz  1 mpc-0.8.1  mpc
+    get_expand_source_tar  ftp://gcc.gnu.org/pub/gcc/infrastructure  isl-0.14   tar.bz2 1 isl-0.14   isl
+
+    # For whatever reason gcc needs this (although it never puts anything into it)
+    # Error: "The directory that should contain system headers does not exist:"
+    # mkdir -p /mingw/include    without --with-sysroot
+    mkdir -p $PREFIXCOQ/mingw/include
+
+    # See https://gcc.gnu.org/install/configure.html
+    logn configure ./configure --build=$BUILD --host=$HOST --target=$TARGET \
+        --prefix=$PREFIXCOQ --program-prefix=$TARGET- --disable-win32-registry --with-sysroot=$PREFIXCOQ \
+        --enable-languages=c --disable-nls \
+        --disable-libsanitizer --disable-libssp --disable-libquadmath --disable-libgomp --disable-libvtv --disable-lto
+        # --disable-decimal-float seems to be required
+        # --with-sysroot=$PREFIX  results in configure error that this is not an absolute path
+    log1 make $MAKE_OPT
+    log2 make install
+    # log2 make clean
+    build_post
+  fi
+}
+
+##### Get sources for Cygwin MinGW packages #####
+
+function get_cygwin_mingw_sources {
+  if [ ! -f flagfiles/cygwin_mingw_sources.finished ] ; then
+    touch flagfiles/cygwin_mingw_sources.started
+
+    # Find all installed files with mingw in the name and download the corresponding source code file from cygwin
+    # Steps:
+    # grep /etc/setup/installed.db for mingw       => mingw64-x86_64-gcc-g++ mingw64-x86_64-gcc-g++-5.4.0-2.tar.bz2 1
+    # remove archive ending and trailing number    => mingw64-x86_64-gcc-g++ mingw64-x86_64-gcc-g++-5.4.0-2
+    # replace space with /                         => ${ARCHIVE} = mingw64-x86_64-gcc-g++/mingw64-x86_64-gcc-g++-5.4.0-2
+    # escape + signs using ${var//pattern/replace} => ${ARCHIVEESC} = mingw64-x86_64-gcc-g++/mingw64-x86_64-gcc-g\+\+-5.4.0-2
+    # grep cygwin setup.ini for installed line + next line (the -A 1 option includes and "after context" of 1 line)
+    # Note that the folders of the installed binaries and source are different. So we cannot grep just for the source line.
+    # We could strip off the path and just grep for the file, though.
+    # => install: x86_64/release/mingw64-x86_64-gcc/mingw64-x86_64-gcc-g++/mingw64-x86_64-gcc-g++-5.4.0-2.tar.xz 10163848 2f8cb7ba3e16ac8ce0455af01de490ded09061b1b06a9a8e367426635b5a33ce230e04005f059d4ea7b52580757da1f6d5bae88eba6b9da76d1bd95e8844b705
+    #    source: x86_64/release/mingw64-x86_64-gcc/mingw64-x86_64-gcc-5.4.0-2-src.tar.xz 95565368 03f22997b7173b243fff65ea46a39613a2e4e75fc7e6cf0fa73b7bcb86071e15ba6d0ca29d330c047fb556a5e684cad57cd2f5adb6e794249e4b01fe27f92c95
+    # Take the 2nd field of the last line          => ${SOURCE} = x86_64/release/mingw64-x86_64-gcc/mingw64-x86_64-gcc-5.4.0-2-src.tar.xz
+    # Remove that path part                        => ${SOURCEFILE} = mingw64-x86_64-gcc-5.4.0-2-src.tar.xz
+
+    grep "mingw" /etc/setup/installed.db | sed 's/\.tar\.bz2 [0-1]$//' | sed 's/ /\//'  | while read ARCHIVE ; do
+      local ARCHIVEESC=${ARCHIVE//+/\\+}
+      local SOURCE=`egrep -A 1 "install: ($CYGWINARCH|noarch)/release/[-+_/a-z0-9]*$ARCHIVEESC" $TARBALLS/setup.ini | tail -1 | cut -d " " -f 2`
+      local SOURCEFILE=${SOURCE##*/}
+
+      # Get the source file (either from the source cache or online)
+      if [ ! -f $TARBALLS/$SOURCEFILE ] ; then
+        if [ -f $SOURCE_LOCAL_CACHE_CFMT/$SOURCEFILE ] ; then
+          cp $SOURCE_LOCAL_CACHE_CFMT/$SOURCEFILE $TARBALLS
+        else
+          wget "$CYGWIN_REPOSITORY/$SOURCE"
+          mv $SOURCEFILE $TARBALLS
+          # Save the source archive in the source cache
+          if [ -d $SOURCE_LOCAL_CACHE_CFMT ] ; then
+            cp $TARBALLS/$SOURCEFILE $SOURCE_LOCAL_CACHE_CFMT
+          fi
+        fi
+      fi
+
+    done
+
+    touch flagfiles/cygwin_mingw_sources.finished
+  fi
+}
+
+##### Coq Windows Installer #####
+
+function make_coq_installer {
+  make_coq
+  make_mingw_make
+  get_cygwin_mingw_sources
+
+  # Prepare the file lists for the installer. We created to file list dumps of the target folder during the build:
+  # ocaml: ocaml + menhir + camlp5 + findlib
+  # ocal_coq: as above + coq
+  
+  # Create coq file list as ocaml_coq / ocaml
+  diff_files coq ocaml_coq ocaml
+  
+  # Filter out object files
+  filter_files coq_objects coq '\.(cmxa|cmi|cma|cmo|a|o)$' 
+  
+  # Filter out plugin object files
+  filter_files coq_objects_plugins coq_objects '/lib/plugins/.*\.(cmxa|cmi|cma|cmo|a|o)$'
+  
+  # Coq objects objects required for plugin development = coq objects except those for pre installed plugins
+  diff_files coq_plugindev coq_objects coq_objects_plugins
+  
+  # Coq files, except objects needed only for plugin development
+  diff_files coq_base coq coq_plugindev
+  
+  # Convert section files to NSIS format
+  files_to_nsis coq_base
+  files_to_nsis coq_plugindev
+  files_to_nsis ocaml
+  
+  # Get and extract NSIS Binaries
+  if build_prep http://downloads.sourceforge.net/project/nsis/NSIS%202/2.51 nsis-2.51 zip ; then
+    NSIS=`pwd`/makensis.exe
+    chmod u+x "$NSIS"
+    # Change to Coq folder
+    cd ../coq-${COQ_VERSION}
+    # Copy patched nsi file
+    cp ../patches/coq_new.nsi dev/nsis
+    cp ../patches/StrRep.nsh dev/nsis
+    cp ../patches/ReplaceInFile.nsh dev/nsis
+    VERSION=`grep ^VERSION= config/Makefile | cut -d = -f 2`
+    cd dev/nsis
+    logn nsis-installer "$NSIS" -DVERSION=$VERSION -DARCH=$ARCH -DCOQ_SRC_PATH=$PREFIXCOQ -DCOQ_ICON=..\\..\\ide\\coq.ico coq_new.nsi
+    
+    build_post
+  fi
+}
+
+###################### TOP LEVEL BUILD #####################
+
+make_gtk2
+make_gtk_sourceview2
+
+make_ocaml
+make_findlib
+make_lablgtk
+make_camlp4
+make_camlp5
+make_menhir
+make_stdint
+list_files ocaml
+make_coq
+
+if [ "$INSTALLMAKE" == "Y" ] ; then
+  make_mingw_make
+fi
+
+list_files ocaml_coq
+
+if [ "$MAKEINSTALLER" == "Y" ] ; then
+  make_coq_installer
+fi
+
diff --git a/dev/build/windows/patches_coq/ReplaceInFile.nsh b/dev/build/windows/patches_coq/ReplaceInFile.nsh
new file mode 100644
index 000000000..27c7eb2fd
--- /dev/null
+++ b/dev/build/windows/patches_coq/ReplaceInFile.nsh
@@ -0,0 +1,67 @@
+; From NSIS Wiki http://nsis.sourceforge.net/ReplaceInFile
+; Modifications:
+; - Replace only once per line
+; - Don't keep original as .old
+; - Use StrRep instead of StrReplace (seems to be cleaner)
+
+Function Func_ReplaceInFile
+  ClearErrors
+
+  Exch $0      ; REPLACEMENT
+  Exch
+  Exch $1      ; SEARCH_TEXT
+  Exch 2
+  Exch $2      ; SOURCE_FILE
+
+  Push $R0     ; SOURCE_FILE file handle
+  Push $R1     ; temporary file handle
+  Push $R2     ; unique temporary file name
+  Push $R3     ; a line to search and replace / save
+  Push $R4     ; shift puffer
+
+  IfFileExists $2 +1 error          ; Check if file exists and open it
+  FileOpen $R0 $2 "r"
+
+  GetTempFileName $R2               ; Create temporary output file
+  FileOpen $R1 $R2 "w"
+
+  loop:                             ; Loop over lines of file
+    FileRead $R0 $R3                ; Read line
+    IfErrors finished
+    Push "$R3"                      ; Replacine string in line once
+    Push "$1"
+    Push "$0"
+    Call Func_StrRep
+    Pop $R3
+    FileWrite $R1 "$R3"             ; Write result
+  Goto loop
+
+  finished:
+    FileClose $R1                   ; Close files
+    FileClose $R0
+    Delete "$2"                     ; Delete original file and rename temporary file to target
+    Rename "$R2" "$2"
+    ClearErrors
+    Goto out
+
+  error:
+    SetErrors
+
+  out:
+  Pop $R4
+  Pop $R3
+  Pop $R2
+  Pop $R1
+  Pop $R0
+  Pop $2
+  Pop $0
+  Pop $1
+FunctionEnd
+
+!macro ReplaceInFile SOURCE_FILE SEARCH_TEXT REPLACEMENT
+  Push "${SOURCE_FILE}"
+  Push "${SEARCH_TEXT}"
+  Push "${REPLACEMENT}"
+  Call Func_ReplaceInFile
+!macroend
+
diff --git a/dev/build/windows/patches_coq/StrRep.nsh b/dev/build/windows/patches_coq/StrRep.nsh
new file mode 100644
index 000000000..d94a9f88b
--- /dev/null
+++ b/dev/build/windows/patches_coq/StrRep.nsh
@@ -0,0 +1,60 @@
+; From NSIS Wiki http://nsis.sourceforge.net/StrRep
+; Slightly modified
+
+Function Func_StrRep
+    Exch $R2 ;new
+    Exch 1
+    Exch $R1 ;old
+    Exch 2
+    Exch $R0 ;string
+    Push $R3
+    Push $R4
+    Push $R5
+    Push $R6
+    Push $R7
+    Push $R8
+    Push $R9
+
+    StrCpy $R3 0
+    StrLen $R4 $R1
+    StrLen $R6 $R0
+    StrLen $R9 $R2
+    loop:
+        StrCpy $R5 $R0 $R4 $R3
+        StrCmp $R5 $R1 found
+        StrCmp $R3 $R6 done
+        IntOp $R3 $R3 + 1 ;move offset by 1 to check the next character
+        Goto loop
+    found:
+        StrCpy $R5 $R0 $R3
+        IntOp $R8 $R3 + $R4
+        StrCpy $R7 $R0 "" $R8
+        StrCpy $R0 $R5$R2$R7
+        StrLen $R6 $R0
+        IntOp $R3 $R3 + $R9 ;move offset by length of the replacement string
+        Goto loop
+    done:
+
+    Pop $R9
+    Pop $R8
+    Pop $R7
+    Pop $R6
+    Pop $R5
+    Pop $R4
+    Pop $R3
+    Push $R0
+    Push $R1
+    Pop $R0
+    Pop $R1
+    Pop $R0
+    Pop $R2
+    Exch $R1
+FunctionEnd
+
+!macro StrRep output string old new
+    Push `${string}`
+    Push `${old}`
+    Push `${new}`
+    Call Func_StrRep
+    Pop ${output}
+!macroend
diff --git a/dev/build/windows/patches_coq/camlp4-4.02+6.patch b/dev/build/windows/patches_coq/camlp4-4.02+6.patch
new file mode 100644
index 000000000..0cdb4a929
--- /dev/null
+++ b/dev/build/windows/patches_coq/camlp4-4.02+6.patch
@@ -0,0 +1,11 @@
+--- camlp4-4.02-6.orig/myocamlbuild.ml	2015-06-17 13:37:36.000000000 +0200
++++ camlp4-4.02+6/myocamlbuild.ml	2016-10-13 13:57:35.512213600 +0200
+@@ -86,7 +86,7 @@
+         let dep = "camlp4"/"boot"/exe in
+         let cmd =
+           let ( / ) = Filename.concat in
+-          "camlp4"/"boot"/exe
++          String.escaped (String.escaped ("camlp4"/"boot"/exe))
+         in
+         (Some dep, cmd)
+     in
diff --git a/dev/build/windows/patches_coq/coq-8.4pl2.patch b/dev/build/windows/patches_coq/coq-8.4pl2.patch
new file mode 100644
index 000000000..45a66d0bf
--- /dev/null
+++ b/dev/build/windows/patches_coq/coq-8.4pl2.patch
@@ -0,0 +1,11 @@
+--- configure	2014-04-14 22:28:39.174177924 +0200
++++ configure	2014-04-14 22:29:23.253025166 +0200
+@@ -335,7 +335,7 @@
+   MAKEVERSION=`$MAKE -v | head -1 | cut -d" " -f3`
+   MAKEVERSIONMAJOR=`echo $MAKEVERSION | cut -d. -f1`
+   MAKEVERSIONMINOR=`echo $MAKEVERSION | cut -d. -f2`
+-  if [ "$MAKEVERSIONMAJOR" -eq 3 -a "$MAKEVERSIONMINOR" -ge 81 ]; then
++  if [ "$MAKEVERSIONMAJOR" -eq 3 -a "$MAKEVERSIONMINOR" -ge 81 ] || [ "$MAKEVERSIONMAJOR" -ge 4 ] ; then
+       echo "You have GNU Make $MAKEVERSION. Good!"
+   else
+       OK="no"
\ No newline at end of file
diff --git a/dev/build/windows/patches_coq/coq-8.4pl6.patch b/dev/build/windows/patches_coq/coq-8.4pl6.patch
new file mode 100644
index 000000000..c3b7f8574
--- /dev/null
+++ b/dev/build/windows/patches_coq/coq-8.4pl6.patch
@@ -0,0 +1,13 @@
+coq-8.4pl6.orig
+--- coq-8.4pl6.orig/configure	2015-04-09 15:59:35.000000000 +0200
++++ coq-8.4pl6//configure	2016-11-09 13:29:42.235319800 +0100
+@@ -309,9 +309,6 @@
+ # executable extension
+ 
+ case "$ARCH,$CYGWIN" in
+-    win32,yes)
+-      EXE=".exe"
+-      DLLEXT=".so";;
+     win32,*)
+       EXE=".exe"
+       DLLEXT=".dll";;
diff --git a/dev/build/windows/patches_coq/coq_new.nsi b/dev/build/windows/patches_coq/coq_new.nsi
new file mode 100644
index 000000000..b88aa066d
--- /dev/null
+++ b/dev/build/windows/patches_coq/coq_new.nsi
@@ -0,0 +1,223 @@
+; This script is used to build the Windows install program for Coq.
+
+; NSIS Modern User Interface
+; Written by Joost Verburg
+; Modified by Julien Narboux, Pierre Letouzey, Enrico Tassi and Michael Soegtrop
+
+; The following command line defines are expected:
+; VERSION      Coq version, e.g. 8.5-pl2
+; ARCH         The target architecture, either x86_64 or i686
+; COQ_SRC_PATH path of Coq installation in Windows or MinGW format (either \\ or /, but with drive letter)
+; COQ_ICON     path of Coq icon file in Windows or MinGW format
+
+; Enable compression after debugging.
+; SetCompress off
+SetCompressor lzma
+
+!define MY_PRODUCT "Coq" ;Define your own software name here
+!define OUTFILE "coq-installer-${VERSION}-${ARCH}.exe"
+
+!include "MUI2.nsh"
+!include "FileAssociation.nsh"
+!include "StrRep.nsh"
+!include "ReplaceInFile.nsh"
+!include "winmessages.nsh"
+
+Var COQ_SRC_PATH_BS   ; COQ_SRC_PATH with \ instead of /
+Var COQ_SRC_PATH_DBS  ; COQ_SRC_PATH with \\ instead of /
+Var INSTDIR_DBS       ; INSTDIR with \\ instead of \
+
+;--------------------------------
+;Configuration
+
+  Name "Coq"
+
+  ;General
+  OutFile "${OUTFILE}"
+
+  ;Folder selection page
+  InstallDir "C:\${MY_PRODUCT}"
+  
+  ;Remember install folder
+  InstallDirRegKey HKCU "Software\${MY_PRODUCT}" ""
+
+;--------------------------------
+;Modern UI Configuration
+  
+  !define MUI_ICON "${COQ_ICON}"
+
+  !insertmacro MUI_PAGE_WELCOME
+  !insertmacro MUI_PAGE_LICENSE "${COQ_SRC_PATH}/license_readme/coq/License.txt"
+  !insertmacro MUI_PAGE_COMPONENTS
+  !define MUI_DIRECTORYPAGE_TEXT_TOP "Select where to install Coq.  The path MUST NOT include spaces."
+  !insertmacro MUI_PAGE_DIRECTORY
+  !insertmacro MUI_PAGE_INSTFILES
+  !insertmacro MUI_PAGE_FINISH
+  
+  !insertmacro MUI_UNPAGE_WELCOME
+  !insertmacro MUI_UNPAGE_CONFIRM
+  !insertmacro MUI_UNPAGE_INSTFILES
+  !insertmacro MUI_UNPAGE_FINISH  
+
+;--------------------------------
+;Languages
+ 
+  !insertmacro MUI_LANGUAGE "English"
+  
+;--------------------------------
+;Language Strings
+
+  ;Description
+  LangString DESC_1 ${LANG_ENGLISH} "This package contains Coq and CoqIDE."
+  LangString DESC_2 ${LANG_ENGLISH} "This package contains an OCaml compiler for Coq native compute and plugin development."
+  LangString DESC_3 ${LANG_ENGLISH} "This package contains the development files needed in order to build a plugin for Coq."
+  LangString DESC_4 ${LANG_ENGLISH} "Set the OCAMLLIB environment variable for the current user."
+  LangString DESC_5 ${LANG_ENGLISH} "Set the OCAMLLIB environment variable for all users."
+
+;--------------------------------
+; Check for white spaces
+Function .onVerifyInstDir
+  StrLen $0 "$INSTDIR"
+  StrCpy $1 0
+  ${While} $1 < $0
+    StrCpy $3 $INSTDIR 1 $1
+    StrCmp $3 " " SpacesInPath
+    IntOp $1 $1 + 1
+  ${EndWhile}
+  Goto done
+  SpacesInPath:
+  Abort
+  done:
+FunctionEnd
+
+;--------------------------------
+;Installer Sections
+
+
+Section "Coq" Sec1
+
+  SetOutPath "$INSTDIR\"
+  !include "..\..\..\filelists\coq_base.nsh"
+
+  ${registerExtension} "$INSTDIR\bin\coqide.exe" ".v" "Coq Script File"
+
+  ;Store install folder
+  WriteRegStr HKCU "Software\${MY_PRODUCT}" "" $INSTDIR
+  
+  ;Create uninstaller
+  WriteUninstaller "$INSTDIR\Uninstall.exe"
+  WriteRegStr HKEY_LOCAL_MACHINE "Software\Microsoft\Windows\CurrentVersion\Uninstall\Coq" \
+      "DisplayName" "Coq Version ${VERSION}"
+  WriteRegStr HKEY_LOCAL_MACHINE "Software\Microsoft\Windows\CurrentVersion\Uninstall\Coq" \
+      "UninstallString" '"$INSTDIR\Uninstall.exe"'
+  WriteRegStr HKEY_LOCAL_MACHINE "Software\Microsoft\Windows\CurrentVersion\Uninstall\Coq" \
+      "DisplayVersion" "${VERSION}"
+  WriteRegDWORD HKEY_LOCAL_MACHINE "Software\Microsoft\Windows\CurrentVersion\Uninstall\Coq" \
+      "NoModify" "1"
+  WriteRegDWORD HKEY_LOCAL_MACHINE "Software\Microsoft\Windows\CurrentVersion\Uninstall\Coq" \
+      "NoRepair" "1"
+  WriteRegStr HKEY_LOCAL_MACHINE "Software\Microsoft\Windows\CurrentVersion\Uninstall\Coq" \
+      "URLInfoAbout" "http://coq.inria.fr"
+
+  ; Create start menu entries
+  ; SetOutPath is required for the path in the .lnk files
+  SetOutPath "$INSTDIR" 
+  CreateDirectory "$SMPROGRAMS\Coq"
+  ; The first shortcut set here is treated as main application by Windows 7/8.
+  ; Use CoqIDE as main application
+  CreateShortCut "$SMPROGRAMS\Coq\CoqIde.lnk" "$INSTDIR\bin\coqide.exe"
+  CreateShortCut "$SMPROGRAMS\Coq\Coq.lnk" "$INSTDIR\bin\coqtop.exe"
+  WriteINIStr "$SMPROGRAMS\Coq\The Coq HomePage.url" "InternetShortcut" "URL" "http://coq.inria.fr"
+  WriteINIStr "$SMPROGRAMS\Coq\The Coq Standard Library.url" "InternetShortcut" "URL" "http://coq.inria.fr/library"
+  CreateShortCut "$SMPROGRAMS\Coq\Uninstall.lnk" "$INSTDIR\Uninstall.exe" "" "$INSTDIR\Uninstall.exe" 0
+
+SectionEnd
+
+;OCAML Section "Ocaml for native compute and plugin development" Sec2
+;OCAML   SetOutPath "$INSTDIR\"
+;OCAML   !include "..\..\..\filelists\ocaml.nsh"
+;OCAML 
+;OCAML   ; Create a few slash / backslash variants of the source and install path
+;OCAML   ; Note: NSIS has variables, written as $VAR and defines, written as ${VAR}
+;OCAML   !insertmacro StrRep $COQ_SRC_PATH_BS  ${COQ_SRC_PATH} "/" "\"
+;OCAML   !insertmacro StrRep $COQ_SRC_PATH_DBS ${COQ_SRC_PATH} "/" "\\"
+;OCAML   !insertmacro StrRep $INSTDIR_DBS      $INSTDIR        "\" "\\"
+;OCAML 
+;OCAML   ; Replace absolute paths in some OCaml config files
+;OCAML   ; These are not all, see ReadMe.txt
+;OCAML   !insertmacro ReplaceInFile "$INSTDIR\libocaml\ld.conf" "/"  "\"
+;OCAML   !insertmacro ReplaceInFile "$INSTDIR\libocaml\ld.conf" "$COQ_SRC_PATH_BS"  "$INSTDIR"
+;OCAML   !insertmacro ReplaceInFile "$INSTDIR\etc\findlib.conf" "$COQ_SRC_PATH_DBS" "$INSTDIR_DBS"
+;OCAML SectionEnd
+ 
+Section "Coq files for plugin developers" Sec3
+  SetOutPath "$INSTDIR\"
+  !include "..\..\..\filelists\coq_plugindev.nsh"
+SectionEnd
+
+;OCAML Section "OCAMLLIB current user" Sec4
+;OCAML    WriteRegStr HKCU "Environment" "OCAMLLIB" "$INSTDIR\libocaml"
+;OCAML    ; This is required, so that a newly started shell gets the new environment variable
+;OCAML    ; But it really takes a few seconds
+;OCAML    DetailPrint "Broadcasting OCAMLLIB environment variable change (current user)"
+;OCAML    SendMessage ${HWND_BROADCAST} ${WM_WININICHANGE} 0 "STR:Environment" /TIMEOUT=1000
+;OCAML SectionEnd
+
+;OCAML Section "OCAMLLIB all users" Sec5
+;OCAML    WriteRegStr HKLM "SYSTEM\CurrentControlSet\Control\Session Manager\Environment" "OCAMLLIB" "$INSTDIR\libocaml"
+;OCAML    ; This is required, so that a newly started shell gets the new environment variable
+;OCAML    ; But it really takes a few seconds
+;OCAML    DetailPrint "Broadcasting OCAMLLIB environment variable change (all users)"
+;OCAML    SendMessage ${HWND_BROADCAST} ${WM_WININICHANGE} 0 "STR:Environment" /TIMEOUT=1000
+;OCAML SectionEnd
+
+;--------------------------------
+;Descriptions
+
+!insertmacro MUI_FUNCTION_DESCRIPTION_BEGIN
+  !insertmacro MUI_DESCRIPTION_TEXT ${Sec1} $(DESC_1)
+  ;OCAML !insertmacro MUI_DESCRIPTION_TEXT ${Sec2} $(DESC_2)
+  !insertmacro MUI_DESCRIPTION_TEXT ${Sec3} $(DESC_3)
+  ;OCAML !insertmacro MUI_DESCRIPTION_TEXT ${Sec4} $(DESC_4)
+  ;OCAML !insertmacro MUI_DESCRIPTION_TEXT ${Sec5} $(DESC_5)
+!insertmacro MUI_FUNCTION_DESCRIPTION_END
+ 
+;--------------------------------
+;Uninstaller Section
+
+Section "Uninstall"
+  ; Files and folders
+  RMDir /r "$INSTDIR\bin"
+  RMDir /r "$INSTDIR\dev"
+  RMDir /r "$INSTDIR\etc"
+  RMDir /r "$INSTDIR\lib"
+  RMDir /r "$INSTDIR\libocaml"
+  RMDir /r "$INSTDIR\share"
+  RMDir /r "$INSTDIR\ide"
+  RMDir /r "$INSTDIR\gtk-2.0"
+  RMDir /r "$INSTDIR\latex"
+  RMDir /r "$INSTDIR\license_readme"
+  RMDir /r "$INSTDIR\man"
+  RMDir /r "$INSTDIR\emacs"
+
+  ; Start Menu
+  Delete "$SMPROGRAMS\Coq\Coq.lnk"
+  Delete "$SMPROGRAMS\Coq\CoqIde.lnk"
+  Delete "$SMPROGRAMS\Coq\Uninstall.lnk"
+  Delete "$SMPROGRAMS\Coq\The Coq HomePage.url"
+  Delete "$SMPROGRAMS\Coq\The Coq Standard Library.url"
+  Delete "$INSTDIR\Uninstall.exe"
+  
+  ; Registry keys
+  DeleteRegKey HKCU "Software\${MY_PRODUCT}"
+  DeleteRegKey HKLM "SOFTWARE\Coq"
+  DeleteRegKey HKLM "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\Coq"
+  DeleteRegKey HKCU "Environment\OCAMLLIB"
+  DeleteRegKey HKLM "SYSTEM\CurrentControlSet\Control\Session Manager\Environment\OCAMLLIB"
+  ${unregisterExtension} ".v" "Coq Script File"
+
+  ; Root folders
+  RMDir "$INSTDIR"
+  RMDir "$SMPROGRAMS\Coq"
+
+SectionEnd
diff --git a/dev/build/windows/patches_coq/flexdll-0.34.patch b/dev/build/windows/patches_coq/flexdll-0.34.patch
new file mode 100644
index 000000000..16389baca
--- /dev/null
+++ b/dev/build/windows/patches_coq/flexdll-0.34.patch
@@ -0,0 +1,14 @@
+reloc.ml
+--- orig.flexdll-0.34/reloc.ml	2015-01-22 17:30:07.000000000 +0100
++++ flexdll-0.34/reloc.ml	2016-10-12 11:59:16.885829700 +0200
+@@ -117,8 +117,8 @@
+ 
+ let new_cmdline () =
+   let rf = match !toolchain with
+-  | `MSVC | `MSVC64 | `LIGHTLD -> true
+-  | `MINGW | `MINGW64 | `GNAT | `CYGWIN | `CYGWIN64 -> false
++  | `MSVC | `MSVC64 | `LIGHTLD | `MINGW | `MINGW64 -> true
++  | `GNAT | `CYGWIN | `CYGWIN64 -> false
+   in
+   {
+    may_use_response_file = rf;
diff --git a/dev/build/windows/patches_coq/glib-2.46.0.patch b/dev/build/windows/patches_coq/glib-2.46.0.patch
new file mode 100644
index 000000000..9082460bf
--- /dev/null
+++ b/dev/build/windows/patches_coq/glib-2.46.0.patch
@@ -0,0 +1,30 @@
+diff -u -r glib-2.46.0/gio/glocalfile.c glib-2.46.0.patched/gio/glocalfile.c
+--- glib-2.46.0/gio/glocalfile.c	2015-08-27 05:32:26.000000000 +0200
++++ glib-2.46.0.patched/gio/glocalfile.c	2016-01-27 13:08:30.059736400 +0100
+@@ -2682,7 +2682,10 @@
+         (!g_path_is_absolute (filename) || len > g_path_skip_root (filename) - filename))
+       wfilename[len] = '\0';
+ 
+-    retval = _wstat32i64 (wfilename, &buf);
++    // MSoegtrop: _wstat32i64 is the wrong function for GLocalFileStat = struct _stati64
++    // The correct function is _wstati64, see https://msdn.microsoft.com/en-us/library/14h5k7ff.aspx
++    // Also _wstat32i64 is a VC function, not a windows SDK function, see https://msdn.microsoft.com/en-us/library/aa273365(v=vs.60).aspx
++    retval = _wstati64 (wfilename, &buf);
+     save_errno = errno;
+ 
+     g_free (wfilename);
+diff -u -r glib-2.46.0/glib/gstdio.c glib-2.46.0.patched/glib/gstdio.c
+--- glib-2.46.0/glib/gstdio.c	2015-02-26 13:57:09.000000000 +0100
++++ glib-2.46.0.patched/glib/gstdio.c	2016-01-27 13:31:12.708987700 +0100
+@@ -493,7 +493,10 @@
+       (!g_path_is_absolute (filename) || len > g_path_skip_root (filename) - filename))
+     wfilename[len] = '\0';
+ 
+-  retval = _wstat (wfilename, buf);
++  // MSoegtrop: _wstat32i64 is the wrong function for GLocalFileStat = struct _stati64
++  // The correct function is _wstati64, see https://msdn.microsoft.com/en-us/library/14h5k7ff.aspx
++  // Also _wstat32i64 is a VC function, not a windows SDK function, see https://msdn.microsoft.com/en-us/library/aa273365(v=vs.60).aspx
++  retval = _wstati64 (wfilename, buf);
+   save_errno = errno;
+ 
+   g_free (wfilename);
diff --git a/dev/build/windows/patches_coq/gtksourceview-2.11.2.patch b/dev/build/windows/patches_coq/gtksourceview-2.11.2.patch
new file mode 100644
index 000000000..73a098d12
--- /dev/null
+++ b/dev/build/windows/patches_coq/gtksourceview-2.11.2.patch
@@ -0,0 +1,213 @@
+diff -c -r gtksourceview-2.11.2.orig/gtksourceview/gtksourceiter.c gtksourceview-2.11.2.patched/gtksourceview/gtksourceiter.c
+*** gtksourceview-2.11.2.orig/gtksourceview/gtksourceiter.c	2010-05-30 12:24:14.000000000 +0200
+--- gtksourceview-2.11.2.patched/gtksourceview/gtksourceiter.c	2015-10-27 14:58:54.422888400 +0100
+***************
+*** 80,86 ****
+  	/* If string contains prefix, check that prefix is not followed
+  	 * by a unicode mark symbol, e.g. that trailing 'a' in prefix
+  	 * is not part of two-char a-with-hat symbol in string. */
+! 	return type != G_UNICODE_COMBINING_MARK &&
+  		type != G_UNICODE_ENCLOSING_MARK &&
+  		type != G_UNICODE_NON_SPACING_MARK;
+  }
+--- 80,86 ----
+  	/* If string contains prefix, check that prefix is not followed
+  	 * by a unicode mark symbol, e.g. that trailing 'a' in prefix
+  	 * is not part of two-char a-with-hat symbol in string. */
+! 	return type != G_UNICODE_SPACING_MARK &&
+  		type != G_UNICODE_ENCLOSING_MARK &&
+  		type != G_UNICODE_NON_SPACING_MARK;
+  }
+diff -c -r gtksourceview-2.11.2.orig/gtksourceview/gtksourcelanguagemanager.c gtksourceview-2.11.2.patched/gtksourceview/gtksourcelanguagemanager.c
+*** gtksourceview-2.11.2.orig/gtksourceview/gtksourcelanguagemanager.c	2010-05-30 12:24:14.000000000 +0200
+--- gtksourceview-2.11.2.patched/gtksourceview/gtksourcelanguagemanager.c	2015-10-27 14:55:30.294477600 +0100
+***************
+*** 274,280 ****
+   * containg a list of language files directories.
+   * The array is owned by @lm and must not be modified.
+   */
+! G_CONST_RETURN gchar* G_CONST_RETURN *
+  gtk_source_language_manager_get_search_path (GtkSourceLanguageManager *lm)
+  {
+  	g_return_val_if_fail (GTK_IS_SOURCE_LANGUAGE_MANAGER (lm), NULL);
+--- 274,280 ----
+   * containg a list of language files directories.
+   * The array is owned by @lm and must not be modified.
+   */
+! const gchar* const *
+  gtk_source_language_manager_get_search_path (GtkSourceLanguageManager *lm)
+  {
+  	g_return_val_if_fail (GTK_IS_SOURCE_LANGUAGE_MANAGER (lm), NULL);
+***************
+*** 392,398 ****
+   * available languages or %NULL if no language is available. The array
+   * is owned by @lm and must not be modified.
+   */
+! G_CONST_RETURN gchar* G_CONST_RETURN *
+  gtk_source_language_manager_get_language_ids (GtkSourceLanguageManager *lm)
+  {
+  	g_return_val_if_fail (GTK_IS_SOURCE_LANGUAGE_MANAGER (lm), NULL);
+--- 392,398 ----
+   * available languages or %NULL if no language is available. The array
+   * is owned by @lm and must not be modified.
+   */
+! const gchar* const *
+  gtk_source_language_manager_get_language_ids (GtkSourceLanguageManager *lm)
+  {
+  	g_return_val_if_fail (GTK_IS_SOURCE_LANGUAGE_MANAGER (lm), NULL);
+diff -c -r gtksourceview-2.11.2.orig/gtksourceview/gtksourcelanguagemanager.h gtksourceview-2.11.2.patched/gtksourceview/gtksourcelanguagemanager.h
+*** gtksourceview-2.11.2.orig/gtksourceview/gtksourcelanguagemanager.h	2009-11-15 00:41:33.000000000 +0100
+--- gtksourceview-2.11.2.patched/gtksourceview/gtksourcelanguagemanager.h	2015-10-27 14:55:30.518500000 +0100
+***************
+*** 62,74 ****
+  
+  GtkSourceLanguageManager *gtk_source_language_manager_get_default		(void);
+  
+! G_CONST_RETURN gchar* G_CONST_RETURN *
+  			  gtk_source_language_manager_get_search_path		(GtkSourceLanguageManager *lm);
+  
+  void			  gtk_source_language_manager_set_search_path		(GtkSourceLanguageManager *lm,
+  										 gchar                   **dirs);
+  
+! G_CONST_RETURN gchar* G_CONST_RETURN *
+  			  gtk_source_language_manager_get_language_ids		(GtkSourceLanguageManager *lm);
+  
+  GtkSourceLanguage	 *gtk_source_language_manager_get_language		(GtkSourceLanguageManager *lm,
+--- 62,74 ----
+  
+  GtkSourceLanguageManager *gtk_source_language_manager_get_default		(void);
+  
+! const gchar* const *
+  			  gtk_source_language_manager_get_search_path		(GtkSourceLanguageManager *lm);
+  
+  void			  gtk_source_language_manager_set_search_path		(GtkSourceLanguageManager *lm,
+  										 gchar                   **dirs);
+  
+! const gchar* const *
+  			  gtk_source_language_manager_get_language_ids		(GtkSourceLanguageManager *lm);
+  
+  GtkSourceLanguage	 *gtk_source_language_manager_get_language		(GtkSourceLanguageManager *lm,
+diff -c -r gtksourceview-2.11.2.orig/gtksourceview/gtksourcestylescheme.c gtksourceview-2.11.2.patched/gtksourceview/gtksourcestylescheme.c
+*** gtksourceview-2.11.2.orig/gtksourceview/gtksourcestylescheme.c	2010-05-30 12:24:14.000000000 +0200
+--- gtksourceview-2.11.2.patched/gtksourceview/gtksourcestylescheme.c	2015-10-27 14:55:30.545502700 +0100
+***************
+*** 310,316 ****
+   *
+   * Since: 2.0
+   */
+! G_CONST_RETURN gchar* G_CONST_RETURN *
+  gtk_source_style_scheme_get_authors (GtkSourceStyleScheme *scheme)
+  {
+  	g_return_val_if_fail (GTK_IS_SOURCE_STYLE_SCHEME (scheme), NULL);
+--- 310,316 ----
+   *
+   * Since: 2.0
+   */
+! const gchar* const *
+  gtk_source_style_scheme_get_authors (GtkSourceStyleScheme *scheme)
+  {
+  	g_return_val_if_fail (GTK_IS_SOURCE_STYLE_SCHEME (scheme), NULL);
+***************
+*** 318,324 ****
+  	if (scheme->priv->authors == NULL)
+  		return NULL;
+  
+! 	return (G_CONST_RETURN gchar* G_CONST_RETURN *)scheme->priv->authors->pdata;
+  }
+  
+  /**
+--- 318,324 ----
+  	if (scheme->priv->authors == NULL)
+  		return NULL;
+  
+! 	return (const gchar* const *)scheme->priv->authors->pdata;
+  }
+  
+  /**
+diff -c -r gtksourceview-2.11.2.orig/gtksourceview/gtksourcestylescheme.h gtksourceview-2.11.2.patched/gtksourceview/gtksourcestylescheme.h
+*** gtksourceview-2.11.2.orig/gtksourceview/gtksourcestylescheme.h	2010-03-29 15:02:56.000000000 +0200
+--- gtksourceview-2.11.2.patched/gtksourceview/gtksourcestylescheme.h	2015-10-27 14:55:30.565504700 +0100
+***************
+*** 61,67 ****
+  const gchar             *gtk_source_style_scheme_get_name       (GtkSourceStyleScheme *scheme);
+  const gchar             *gtk_source_style_scheme_get_description(GtkSourceStyleScheme *scheme);
+  
+! G_CONST_RETURN gchar* G_CONST_RETURN *
+  			 gtk_source_style_scheme_get_authors	(GtkSourceStyleScheme *scheme);
+  
+  const gchar             *gtk_source_style_scheme_get_filename	(GtkSourceStyleScheme *scheme);
+--- 61,67 ----
+  const gchar             *gtk_source_style_scheme_get_name       (GtkSourceStyleScheme *scheme);
+  const gchar             *gtk_source_style_scheme_get_description(GtkSourceStyleScheme *scheme);
+  
+! const gchar* const *
+  			 gtk_source_style_scheme_get_authors	(GtkSourceStyleScheme *scheme);
+  
+  const gchar             *gtk_source_style_scheme_get_filename	(GtkSourceStyleScheme *scheme);
+diff -c -r gtksourceview-2.11.2.orig/gtksourceview/gtksourcestyleschememanager.c gtksourceview-2.11.2.patched/gtksourceview/gtksourcestyleschememanager.c
+*** gtksourceview-2.11.2.orig/gtksourceview/gtksourcestyleschememanager.c	2010-05-30 12:24:14.000000000 +0200
+--- gtksourceview-2.11.2.patched/gtksourceview/gtksourcestyleschememanager.c	2015-10-27 14:55:30.583506500 +0100
+***************
+*** 515,521 ****
+   * of string containing the search path.
+   * The array is owned by the @manager and must not be modified.
+   */
+! G_CONST_RETURN gchar* G_CONST_RETURN *
+  gtk_source_style_scheme_manager_get_search_path (GtkSourceStyleSchemeManager *manager)
+  {
+  	g_return_val_if_fail (GTK_IS_SOURCE_STYLE_SCHEME_MANAGER (manager), NULL);
+--- 515,521 ----
+   * of string containing the search path.
+   * The array is owned by the @manager and must not be modified.
+   */
+! const gchar* const *
+  gtk_source_style_scheme_manager_get_search_path (GtkSourceStyleSchemeManager *manager)
+  {
+  	g_return_val_if_fail (GTK_IS_SOURCE_STYLE_SCHEME_MANAGER (manager), NULL);
+***************
+*** 554,560 ****
+   * of string containing the ids of the available style schemes or %NULL if no
+   * style scheme is available. The array is owned by the @manager and must not be modified.
+   */
+! G_CONST_RETURN gchar* G_CONST_RETURN *
+  gtk_source_style_scheme_manager_get_scheme_ids (GtkSourceStyleSchemeManager *manager)
+  {
+  	g_return_val_if_fail (GTK_IS_SOURCE_STYLE_SCHEME_MANAGER (manager), NULL);
+--- 554,560 ----
+   * of string containing the ids of the available style schemes or %NULL if no
+   * style scheme is available. The array is owned by the @manager and must not be modified.
+   */
+! const gchar* const *
+  gtk_source_style_scheme_manager_get_scheme_ids (GtkSourceStyleSchemeManager *manager)
+  {
+  	g_return_val_if_fail (GTK_IS_SOURCE_STYLE_SCHEME_MANAGER (manager), NULL);
+diff -c -r gtksourceview-2.11.2.orig/gtksourceview/gtksourcestyleschememanager.h gtksourceview-2.11.2.patched/gtksourceview/gtksourcestyleschememanager.h
+*** gtksourceview-2.11.2.orig/gtksourceview/gtksourcestyleschememanager.h	2009-11-15 00:41:33.000000000 +0100
+--- gtksourceview-2.11.2.patched/gtksourceview/gtksourcestyleschememanager.h	2015-10-27 14:56:24.498897500 +0100
+***************
+*** 73,84 ****
+  void 			 gtk_source_style_scheme_manager_prepend_search_path   (GtkSourceStyleSchemeManager	*manager,
+  						    				 const gchar			*path);
+  
+! G_CONST_RETURN gchar* G_CONST_RETURN *
+  			 gtk_source_style_scheme_manager_get_search_path	(GtkSourceStyleSchemeManager	*manager);
+  
+  void			 gtk_source_style_scheme_manager_force_rescan		(GtkSourceStyleSchemeManager	*manager);
+  
+! G_CONST_RETURN gchar* G_CONST_RETURN *
+  			 gtk_source_style_scheme_manager_get_scheme_ids		(GtkSourceStyleSchemeManager	*manager);
+  
+  GtkSourceStyleScheme	*gtk_source_style_scheme_manager_get_scheme		(GtkSourceStyleSchemeManager	*manager,
+--- 73,84 ----
+  void 			 gtk_source_style_scheme_manager_prepend_search_path   (GtkSourceStyleSchemeManager	*manager,
+  						    				 const gchar			*path);
+  
+! const gchar* const *
+  			 gtk_source_style_scheme_manager_get_search_path	(GtkSourceStyleSchemeManager	*manager);
+  
+  void			 gtk_source_style_scheme_manager_force_rescan		(GtkSourceStyleSchemeManager	*manager);
+  
+! const gchar* const *
+  			 gtk_source_style_scheme_manager_get_scheme_ids		(GtkSourceStyleSchemeManager	*manager);
+  
+  GtkSourceStyleScheme	*gtk_source_style_scheme_manager_get_scheme		(GtkSourceStyleSchemeManager	*manager,
diff --git a/dev/build/windows/patches_coq/isl-0.14.patch b/dev/build/windows/patches_coq/isl-0.14.patch
new file mode 100644
index 000000000..f3b8ead1a
--- /dev/null
+++ b/dev/build/windows/patches_coq/isl-0.14.patch
@@ -0,0 +1,11 @@
+--- orig.isl-0.14/configure	2014-10-26 08:36:32.000000000 +0100
++++ isl-0.14/configure	2016-10-10 18:16:01.430224500 +0200
+@@ -8134,7 +8134,7 @@
+      lt_sysroot=`$CC --print-sysroot 2>/dev/null`
+    fi
+    ;; #(
+- /*)
++ /*|[A-Z]:\\*|[A-Z]:/*)
+    lt_sysroot=`echo "$with_sysroot" | sed -e "$sed_quote_subst"`
+    ;; #(
+  no|'')
diff --git a/dev/build/windows/patches_coq/lablgtk-2.18.3.patch b/dev/build/windows/patches_coq/lablgtk-2.18.3.patch
new file mode 100644
index 000000000..0691c1fc8
--- /dev/null
+++ b/dev/build/windows/patches_coq/lablgtk-2.18.3.patch
@@ -0,0 +1,87 @@
+diff -u -r lablgtk-2.18.3/configure lablgtk-2.18.3.patched/configure
+--- lablgtk-2.18.3/configure	2014-10-29 08:51:05.000000000 +0100
++++ lablgtk-2.18.3.patched/configure	2015-10-29 08:58:08.543985500 +0100
+@@ -2667,7 +2667,7 @@
+ fi
+ 
+ 
+-if test "`$OCAMLFIND printconf stdlib`" != "`$CAMLC -where`"; then
++if test "`$OCAMLFIND printconf stdlib | tr '\\' '/'`" != "`$CAMLC -where | tr '\\' '/'`"; then
+   { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Ignoring ocamlfind" >&5
+ $as_echo "$as_me: WARNING: Ignoring ocamlfind" >&2;}
+   OCAMLFIND=no
+
+diff -u -r lablgtk-2.18.3/src/glib.mli lablgtk-2.18.3.patched/src/glib.mli
+--- lablgtk-2.18.3/src/glib.mli	2014-10-29 08:51:06.000000000 +0100
++++ lablgtk-2.18.3.patched/src/glib.mli	2016-01-25 09:50:59.884715200 +0100
+@@ -75,6 +75,7 @@
+   type condition = [ `ERR | `HUP | `IN | `NVAL | `OUT | `PRI]
+   type id
+   val channel_of_descr : Unix.file_descr -> channel
++  val channel_of_descr_socket : Unix.file_descr -> channel
+   val add_watch :
+     cond:condition list -> callback:(condition list -> bool) -> ?prio:int -> channel -> id
+   val remove : id -> unit
+
+diff -u -r lablgtk-2.18.3/src/glib.ml lablgtk-2.18.3.patched/src/glib.ml
+--- lablgtk-2.18.3/src/glib.ml	2014-10-29 08:51:06.000000000 +0100
++++ lablgtk-2.18.3.patched/src/glib.ml	2016-01-25 09:50:59.891715900 +0100
+@@ -72,6 +72,8 @@
+   type id
+   external channel_of_descr : Unix.file_descr -> channel
+     = "ml_g_io_channel_unix_new"
++  external channel_of_descr_socket : Unix.file_descr -> channel
++    = "ml_g_io_channel_unix_new_socket"
+   external remove : id -> unit = "ml_g_source_remove"
+   external add_watch :
+     cond:condition list -> callback:(condition list -> bool) -> ?prio:int -> channel -> id
+
+diff -u -r lablgtk-2.18.3/src/ml_glib.c lablgtk-2.18.3.patched/src/ml_glib.c
+--- lablgtk-2.18.3/src/ml_glib.c	2014-10-29 08:51:06.000000000 +0100
++++ lablgtk-2.18.3.patched/src/ml_glib.c	2016-01-25 09:50:59.898716600 +0100
+@@ -25,6 +25,8 @@
+ #include <string.h>
+ #include <locale.h>
+ #ifdef _WIN32
++/* to kill a #warning: include winsock2.h before windows.h */
++#include <winsock2.h>
+ #include "win32.h"
+ #include <wtypes.h>
+ #include <io.h>
+@@ -38,6 +40,11 @@
+ #include <caml/callback.h>
+ #include <caml/threads.h>
+ 
++#ifdef _WIN32
++/* for Socket_val */
++#include <caml/unixsupport.h>
++#endif
++
+ #include "wrappers.h"
+ #include "ml_glib.h"
+ #include "glib_tags.h"
+@@ -325,14 +332,23 @@
+ 
+ #ifndef _WIN32
+ ML_1 (g_io_channel_unix_new, Int_val, Val_GIOChannel_noref)
++CAMLprim value ml_g_io_channel_unix_new_socket (value arg1) {
++  return Val_GIOChannel_noref (g_io_channel_unix_new (Int_val (arg1))); 
++}
+ 
+ #else
+ CAMLprim value ml_g_io_channel_unix_new(value wh)
+ {
+   return Val_GIOChannel_noref
+-    (g_io_channel_unix_new
++    (g_io_channel_win32_new_fd
+      (_open_osfhandle((long)*(HANDLE*)Data_custom_val(wh), O_BINARY)));
+ }
++
++CAMLprim value ml_g_io_channel_unix_new_socket(value wh)
++{
++  return Val_GIOChannel_noref
++    (g_io_channel_win32_new_socket(Socket_val(wh)));
++}
+ #endif
+ 
+ static gboolean ml_g_io_channel_watch(GIOChannel *s, GIOCondition c,
diff --git a/dev/build/windows/patches_coq/ln.c b/dev/build/windows/patches_coq/ln.c
new file mode 100644
index 000000000..5e02c72bb
--- /dev/null
+++ b/dev/build/windows/patches_coq/ln.c
@@ -0,0 +1,137 @@
+// (C) 2016 Intel Deutschland GmbH
+// Author: Michael Soegtrop
+// Released to the public under CC0
+// See https://creativecommons.org/publicdomain/zero/1.0/
+
+// Windows drop in repacement for Linux ln
+// Supports command form "ln TARGET LINK_NAME"
+// Supports -s and -f options
+// Does not support hard links to folders (but symlinks are ok)
+
+#include <windows.h>
+#include <stdio.h>
+#include <tchar.h>
+
+// Cygwin MinGW doesn't have this Vista++ function in windows.h
+#ifdef UNICODE
+    WINBASEAPI BOOLEAN APIENTRY CreateSymbolicLinkW ( LPCWSTR, LPCWSTR, DWORD );
+    #define CreateSymbolicLink  CreateSymbolicLinkW
+    #define CommandLineToArgv CommandLineToArgvW
+#else
+    WINBASEAPI BOOLEAN APIENTRY CreateSymbolicLinkA ( LPCSTR, LPCSTR, DWORD );
+    #define CreateSymbolicLink  CreateSymbolicLinkA
+    #define CommandLineToArgv CommandLineToArgvA
+#endif
+#define SYMBOLIC_LINK_FLAG_DIRECTORY 1
+
+int WINAPI WinMain( HINSTANCE hInstance, HINSTANCE hPrevInstance, LPSTR lpCmdLineA, int nShowCmd )
+{
+    int iarg;
+    BOOL symbolic = FALSE;
+    BOOL force = FALSE;
+    BOOL folder;
+    const _TCHAR *target;
+    const _TCHAR *link;
+    LPTSTR lpCmdLine; 
+    int argc;
+    LPTSTR *argv;
+
+    // Parse command line
+    // This is done explicitly here for two reasons
+    // 1.) MinGW doesn't seem to support _tmain, wWinMain and the like
+    // 2.) We want to make sure that CommandLineToArgv is used
+    lpCmdLine = GetCommandLine();
+    argv = CommandLineToArgv( lpCmdLine, &argc );
+    
+    // Get target and link name
+    if( argc<3 )
+    {
+        _ftprintf( stderr, _T("Expecting at least 2 arguments, got %d\n"), argc-1 );
+        return 1;
+    }
+    target = argv[argc-2];
+    link = argv[argc-1];
+
+    // Parse options
+    // The last two arguments are interpreted as file names
+    // All other arguments must be -s or -f os multi letter options like -sf
+    for(iarg=1; iarg<argc-2; iarg++ )
+    {
+        const _TCHAR *pos = argv[iarg]; 
+        if( *pos != _T('-') )
+        {
+            _ftprintf( stderr, _T("Command line option expected in argument %d\n"), iarg );
+            return 1;
+        }
+        pos ++;
+
+        while( *pos )
+        {
+            switch( *pos )
+            {
+                case _T('s') : symbolic = TRUE; break;
+                case _T('f') : force = TRUE; break;
+                default : 
+                    _ftprintf( stderr, _T("Unknown option '%c'\n"), *pos );
+                    return 1;
+            }
+            pos ++;
+        }
+    }
+    
+    #ifdef IGNORE_SYMBOLIC
+        symbolic = FALSE;
+    #endif
+    
+    // Check if link already exists - delete it if force is given or abort
+    {
+        if( GetFileAttributes(link) != INVALID_FILE_ATTRIBUTES )
+        {
+            if( force )
+            {
+                if( !DeleteFile( link ) )
+                {
+                    _ftprintf( stderr, _T("Error deleting file '%s'\n"), link );
+                    return 1;
+                }
+            }
+            else
+            {
+                _ftprintf( stderr, _T("File '%s' exists!\n"), link );
+                return 1;
+            }
+        }
+    }
+    
+    // Check if target is a folder
+    folder = ( (GetFileAttributes(target) & FILE_ATTRIBUTE_DIRECTORY) ) != 0;
+    
+    // Create link
+    if(symbolic)
+    {
+        if( !CreateSymbolicLink( link, target, folder ? SYMBOLIC_LINK_FLAG_DIRECTORY : 0 ) )
+        {
+            _ftprintf( stderr, _T("Error creating symbolic link '%s' -> '%s'!\n"), link, target );
+            return 1;
+        }
+    }
+    else
+    {
+        if( folder )
+        {
+            _ftprintf( stderr, _T("Cannot create hard link to folder") );
+            return 1;
+        }
+        else
+        {
+            if( !CreateHardLink( link, target, NULL ) )
+            {
+                _ftprintf( stderr, _T("Error creating hard link '%s' -> '%s'!\n"), link, target );
+                return 1;
+            }
+        }
+    }
+    
+    // Everything is fine
+    return 0;
+}
\ No newline at end of file
diff --git a/dev/ci/ci-color.sh b/dev/ci/ci-color.sh
new file mode 100755
index 000000000..78ae7f02f
--- /dev/null
+++ b/dev/ci/ci-color.sh
@@ -0,0 +1,8 @@
+#!/bin/bash
+
+ci_dir="$(dirname "$0")"
+source ${ci_dir}/ci-common.sh
+
+svn checkout https://scm.gforge.inria.fr/anonscm/svn/color/trunk/color color
+
+( cd color && make -j ${NJOBS} )
diff --git a/dev/ci/ci-common.sh b/dev/ci/ci-common.sh
new file mode 100644
index 000000000..412da626f
--- /dev/null
+++ b/dev/ci/ci-common.sh
@@ -0,0 +1,52 @@
+#!/bin/bash
+
+set -xe
+
+# Coq's tools need an ending slash :S, we should fix them.
+export COQBIN=`pwd`/bin/
+export PATH=`pwd`/bin:$PATH
+
+ls `pwd`/bin
+
+# Maybe we should just use Ruby...
+mathcomp_CI_BRANCH=master
+mathcomp_CI_GITURL=https://github.com/math-comp/math-comp.git
+
+# git_checkout branch
+git_checkout()
+{
+  local _BRANCH=${1}
+  local _URL=${2}
+  local _DEST=${3}
+
+  echo "Checking out ${_DEST}"
+  git clone --depth 1 -b ${_BRANCH} ${_URL} ${_DEST}
+  ( cd ${3} && echo "${_DEST}: `git log -1 --format='%s | %H | %cd | %aN'`" )
+}
+
+checkout_mathcomp()
+{
+  git_checkout ${mathcomp_CI_BRANCH} ${mathcomp_CI_GITURL} ${1}
+}
+
+# this installs just the ssreflect library of math-comp
+install_ssreflect()
+{
+  echo 'Installing ssreflect' && echo -en 'travis_fold:start:ssr.install\\r'
+
+  checkout_mathcomp math-comp
+  ( cd math-comp/mathcomp            && \
+    sed -i.bak '/ssrtest/d'     Make && \
+    sed -i.bak '/odd_order/d'   Make && \
+    sed -i.bak '/all\/all.v/d'  Make && \
+    sed -i.bak '/character/d'   Make && \
+    sed -i.bak '/real_closed/d' Make && \
+    sed -i.bak '/solvable/d'    Make && \
+    sed -i.bak '/field/d'       Make && \
+    sed -i.bak '/fingroup/d'    Make && \
+    sed -i.bak '/algebra/d'     Make && \
+    make Makefile.coq && make -f Makefile.coq -j ${NJOBS} all && make install )
+
+  echo -en 'travis_fold:end:ssr.install\\r'
+
+}
diff --git a/dev/ci/ci-compcert.sh b/dev/ci/ci-compcert.sh
new file mode 100755
index 000000000..ec09389f8
--- /dev/null
+++ b/dev/ci/ci-compcert.sh
@@ -0,0 +1,13 @@
+#!/bin/bash
+
+ci_dir="$(dirname "$0")"
+source ${ci_dir}/ci-common.sh
+
+CompCert_CI_BRANCH=master
+CompCert_CI_GITURL=https://github.com/AbsInt/CompCert.git
+
+opam install -j ${NJOBS} -y menhir
+git_checkout ${CompCert_CI_BRANCH} ${CompCert_CI_GITURL} CompCert
+
+# Patch to avoid the upper version limit
+( cd CompCert && sed -i.bak 's/8.6)/8.6|trunk)/' configure && ./configure x86_32-linux && make -j ${NJOBS} )
diff --git a/dev/ci/ci-coquelicot.sh b/dev/ci/ci-coquelicot.sh
new file mode 100755
index 000000000..94bd5e468
--- /dev/null
+++ b/dev/ci/ci-coquelicot.sh
@@ -0,0 +1,12 @@
+#!/bin/bash
+
+# $0 is not the safest way, but...
+ci_dir="$(dirname "$0")"
+source ${ci_dir}/ci-common.sh
+
+install_ssreflect
+
+# Setup coquelicot
+git_checkout master https://scm.gforge.inria.fr/anonscm/git/coquelicot/coquelicot.git coquelicot
+
+( cd coquelicot && ./autogen.sh && ./configure && ./remake -j${NJOBS} )
diff --git a/dev/ci/ci-cpdt.sh b/dev/ci/ci-cpdt.sh
new file mode 100755
index 000000000..18d756180
--- /dev/null
+++ b/dev/ci/ci-cpdt.sh
@@ -0,0 +1,10 @@
+#!/bin/bash
+
+ci_dir="$(dirname "$0")"
+source ${ci_dir}/ci-common.sh
+
+wget http://adam.chlipala.net/cpdt/cpdt.tgz
+tar xvfz cpdt.tgz
+
+( cd cpdt && make clean && make -j ${NJOBS} )
+
diff --git a/dev/ci/ci-fiat-crypto.sh b/dev/ci/ci-fiat-crypto.sh
new file mode 100755
index 000000000..c669195dd
--- /dev/null
+++ b/dev/ci/ci-fiat-crypto.sh
@@ -0,0 +1,9 @@
+#!/bin/bash
+
+# $0 is not the safest way, but...
+ci_dir="$(dirname "$0")"
+source ${ci_dir}/ci-common.sh
+
+git_checkout master https://github.com/mit-plv/fiat-crypto.git fiat-crypto
+
+( cd fiat-crypto && make -j ${NJOBS} )
diff --git a/dev/ci/ci-flocq.sh b/dev/ci/ci-flocq.sh
new file mode 100755
index 000000000..345924e40
--- /dev/null
+++ b/dev/ci/ci-flocq.sh
@@ -0,0 +1,9 @@
+#!/bin/bash
+
+# $0 is not the safest way, but...
+ci_dir="$(dirname "$0")"
+source ${ci_dir}/ci-common.sh
+
+git_checkout master https://scm.gforge.inria.fr/anonscm/git/flocq/flocq.git flocq
+
+( cd flocq && ./autogen.sh && ./configure && ./remake -j${NJOBS} )
diff --git a/dev/ci/ci-geocoq.sh b/dev/ci/ci-geocoq.sh
new file mode 100755
index 000000000..ce870e52b
--- /dev/null
+++ b/dev/ci/ci-geocoq.sh
@@ -0,0 +1,16 @@
+#!/bin/bash
+
+ci_dir="$(dirname "$0")"
+source ${ci_dir}/ci-common.sh
+
+# XXX: replace by generic template
+GeoCoq_CI_BRANCH=master
+GeoCoq_CI_GITURL=https://github.com/GeoCoq/GeoCoq.git
+
+git_checkout ${GeoCoq_CI_BRANCH} ${GeoCoq_CI_GITURL} GeoCoq
+
+( cd GeoCoq                                               && \
+  ./configure.sh                                          && \
+  sed -i.bak '/Ch16_coordinates_with_functions\.v/d' Make && \
+  coq_makefile -f Make -o Makefile                        && \
+  make -j ${NJOBS} )
diff --git a/dev/ci/ci-hott.sh b/dev/ci/ci-hott.sh
new file mode 100755
index 000000000..aaffc9d48
--- /dev/null
+++ b/dev/ci/ci-hott.sh
@@ -0,0 +1,8 @@
+#!/bin/bash
+
+ci_dir="$(dirname "$0")"
+source ${ci_dir}/ci-common.sh
+
+git_checkout mz-8.6 https://github.com/ejgallego/HoTT.git HoTT
+
+( cd HoTT && ./autogen.sh && ./configure && make -j ${NJOBS} )
diff --git a/dev/ci/ci-iris-coq.sh b/dev/ci/ci-iris-coq.sh
new file mode 100755
index 000000000..c21af976f
--- /dev/null
+++ b/dev/ci/ci-iris-coq.sh
@@ -0,0 +1,17 @@
+#!/bin/bash
+
+# $0 is not the safest way, but...
+ci_dir="$(dirname "$0")"
+source ${ci_dir}/ci-common.sh
+
+install_ssreflect
+
+# Setup stdpp
+git_checkout master https://gitlab.mpi-sws.org/robbertkrebbers/coq-stdpp.git coq-stdpp
+
+( cd coq-stdpp && make -j ${NJOBS} && make install )
+
+# Setup Iris
+git_checkout master https://gitlab.mpi-sws.org/FP/iris-coq.git iris-coq
+
+( cd iris-coq && make -j ${NJOBS} )
diff --git a/dev/ci/ci-math-classes.sh b/dev/ci/ci-math-classes.sh
new file mode 100755
index 000000000..4450dc071
--- /dev/null
+++ b/dev/ci/ci-math-classes.sh
@@ -0,0 +1,12 @@
+#!/bin/bash
+
+# $0 is not the safest way, but...
+ci_dir="$(dirname "$0")"
+source ${ci_dir}/ci-common.sh
+
+git_checkout v8.6 https://github.com/math-classes/math-classes.git math-classes
+( cd math-classes && make -j ${NJOBS} && make install )
+
+git_checkout v8.6 https://github.com/c-corn/corn.git corn
+( cd corn         && make -j ${NJOBS} )
+
diff --git a/dev/ci/ci-math-comp.sh b/dev/ci/ci-math-comp.sh
new file mode 100755
index 000000000..2eb150cb5
--- /dev/null
+++ b/dev/ci/ci-math-comp.sh
@@ -0,0 +1,13 @@
+#!/bin/bash
+
+# $0 is not the safest way, but...
+ci_dir="$(dirname "$0")"
+source ${ci_dir}/ci-common.sh
+
+checkout_mathcomp math-comp
+
+# odd_order takes too much time for travis.
+( cd math-comp/mathcomp                           && \
+  sed -i.bak '/PFsection/d'                  Make && \
+  sed -i.bak '/stripped_odd_order_theorem/d' Make && \
+  make Makefile.coq && make -f Makefile.coq -j ${NJOBS} all )
diff --git a/dev/ci/ci-metacoq.sh b/dev/ci/ci-metacoq.sh
new file mode 100755
index 000000000..91a33695b
--- /dev/null
+++ b/dev/ci/ci-metacoq.sh
@@ -0,0 +1,16 @@
+#!/bin/bash
+
+# $0 is not the safest way, but...
+ci_dir="$(dirname "$0")"
+source ${ci_dir}/ci-common.sh
+
+# MetaCoq + UniCoq
+
+git_checkout master https://github.com/unicoq/unicoq.git unicoq
+
+( cd unicoq && coq_makefile -f Make -o Makefile && make -j ${NJOBS} && make install )
+
+git_checkout master https://github.com/MetaCoq/MetaCoq.git MetaCoq
+
+( cd MetaCoq && coq_makefile -f _CoqProject -o Makefile && make -j ${NJOBS} )
+
diff --git a/dev/ci/ci-sf.sh b/dev/ci/ci-sf.sh
new file mode 100755
index 000000000..5e41211f1
--- /dev/null
+++ b/dev/ci/ci-sf.sh
@@ -0,0 +1,11 @@
+#!/bin/bash
+
+ci_dir="$(dirname "$0")"
+source ${ci_dir}/ci-common.sh
+
+wget https://www.cis.upenn.edu/~bcpierce/sf/current/sf.tgz
+tar xvfz sf.tgz
+
+( cd sf && sed -i.bak 's/(K,N)/((K,N))/' LibTactics.v && make clean && make -j ${NJOBS} )
+
+
diff --git a/dev/ci/ci-tlc.sh b/dev/ci/ci-tlc.sh
new file mode 100755
index 000000000..b94632492
--- /dev/null
+++ b/dev/ci/ci-tlc.sh
@@ -0,0 +1,8 @@
+#!/bin/bash
+
+ci_dir="$(dirname "$0")"
+source ${ci_dir}/ci-common.sh
+
+git_checkout master https://gforge.inria.fr/git/tlc/tlc.git tlc
+
+( cd tlc && make -j ${NJOBS} )
diff --git a/dev/ci/ci-unimath.sh b/dev/ci/ci-unimath.sh
new file mode 100755
index 000000000..15e619acb
--- /dev/null
+++ b/dev/ci/ci-unimath.sh
@@ -0,0 +1,15 @@
+#!/bin/bash
+
+ci_dir="$(dirname "$0")"
+source ${ci_dir}/ci-common.sh
+
+UniMath_CI_BRANCH=master
+UniMath_CI_GITURL=https://github.com/UniMath/UniMath.git
+
+git_checkout ${UniMath_CI_BRANCH} ${UniMath_CI_GITURL} UniMath
+
+( cd UniMath                                  && \
+  sed -i.bak '/Folds/d'              Makefile && \
+  sed -i.bak '/HomologicalAlgebra/d' Makefile && \
+  make -j ${NJOBS} BUILD_COQ=no )
+
diff --git a/dev/core.dbg b/dev/core.dbg
new file mode 100644
index 000000000..698db63d2
--- /dev/null
+++ b/dev/core.dbg
@@ -0,0 +1,19 @@
+source camlp4.dbg
+load_printer threads.cma
+load_printer str.cma
+load_printer clib.cma
+load_printer lib.cma
+load_printer kernel.cma
+load_printer library.cma
+load_printer engine.cma
+load_printer pretyping.cma
+load_printer interp.cma
+load_printer proofs.cma
+load_printer parsing.cma
+load_printer printing.cma
+load_printer tactics.cma
+load_printer vernac.cma
+load_printer stm.cma
+load_printer toplevel.cma
+load_printer highparsing.cma
+load_printer ltac.cma
diff --git a/dev/db b/dev/db
index 86e35a3ec..d3503ef43 100644
--- a/dev/db
+++ b/dev/db
@@ -1,4 +1,5 @@
-load_printer "printers.cma"
+source core.dbg
+load_printer top_printers.cmo
 
 install_printer Top_printers.ppfuture
 
@@ -51,6 +52,7 @@ install_printer Top_printers.prsubst
 install_printer Top_printers.prdelta
 install_printer Top_printers.ppfconstr
 install_printer Top_printers.ppgenarginfo
+install_printer Top_printers.ppgenargargt
 install_printer Top_printers.ppist
 install_printer Top_printers.ppconstrunderbindersidmap
 install_printer Top_printers.ppunbound_ltac_var_map
diff --git a/dev/doc/build-system.txt b/dev/doc/build-system.txt
index 4593a6ad5..873adc1b2 100644
--- a/dev/doc/build-system.txt
+++ b/dev/doc/build-system.txt
@@ -117,7 +117,7 @@ Targets for cleaning various parts:
 ---------------
 
 There is now two kinds of preprocessed files : 
- - a .mlp do not need grammar.cma (they are in grammar/ and tools/compat5*.mlp)
+ - a .mlp do not need grammar.cma (they are in grammar/)
  - a .ml4 is now always preprocessed with grammar.cma (and q_constr.cmo),
    except coqide_main.ml4 and its specific rule
 
diff --git a/dev/doc/changes.txt b/dev/doc/changes.txt
index 4a0130bef..f54f3fcc8 100644
--- a/dev/doc/changes.txt
+++ b/dev/doc/changes.txt
@@ -1,7 +1,122 @@
 =========================================
+= CHANGES BETWEEN COQ V8.6 AND COQ V8.7 =
+=========================================
+
+* ML API *
+
+We renamed the following functions:
+
+  Context.Rel.Declaration.fold   -> Context.Rel.Declaration.fold_constr
+  Context.Named.Declaration.fold -> Context.Named.Declaration.fold_constr
+  Printer.pr_var_list_decl       -> Printer.pr_compacted_decl
+  Printer.pr_var_decl            -> Printer.pr_named_decl
+  Nameops.lift_subscript         -> Nameops.increment_subscript
+
+We removed the following functions:
+
+  Termops.compact_named_context_reverse ... practical substitute is Termops.compact_named_context
+  Namegen.to_avoid                      ... equivalent substitute is Names.Id.List.mem
+
+We renamed the following modules:
+
+  Context.ListNamed -> Context.Compacted
+
+The following type aliases where removed
+
+  Context.section_context    ... it was just an alias for "Context.Named.t" which is still available
+
+The module Constrarg was merged into Stdarg.
+
+** Ltac API **
+
+Many Ltac specific API has been moved in its own ltac/ folder. Amongst other
+important things:
+
+- Pcoq.Tactic -> Pltac
+- Constrarg.wit_tactic -> Tacarg.wit_tactic
+- Constrarg.wit_ltac -> Tacarg.wit_ltac
+- API below ltac/ that accepted a *_tactic_expr now accept a *_generic_argument
+  instead
+- Some printing functions were moved from Pptactic to Pputils
+- A part of Tacexpr has been moved to Tactypes
+
+** Error handling **
+
+- All error functions now take an optional parameter `?loc:Loc.t`. For
+  functions that used to carry a suffix `_loc`, such suffix has been
+  dropped.
+
+- `errorlabstrm` has been removed in favor of `user_err`.
+
+- The header parameter to `user_err` has been made optional.
+
+=========================================
 = CHANGES BETWEEN COQ V8.5 AND COQ V8.6 =
 =========================================
 
+** Parsing **
+
+Pcoq.parsable now takes an extra optional filename argument so as to
+bind locations to a file name when relevant.
+
+** Files **
+
+To avoid clashes with OCaml's compiler libs, the following files were renamed:
+kernel/closure.ml{,i} -> kernel/cClosure.ml{,i}
+lib/errors.ml{,i} -> lib/cErrors.ml{,i}
+toplevel/cerror.ml{,i} -> toplevel/explainErr.mli{,i}
+
+All IDE-specific files, including the XML protocol have been moved to ide/
+
+** Reduction functions **
+
+In closure.ml, we introduced the more precise reduction flags fMATCH, fFIX,
+fCOFIX.
+
+We renamed the following functions:
+
+Closure.betadeltaiota -> Closure.all
+Closure.betadeltaiotanolet -> Closure.allnolet
+Reductionops.beta -> Closure.beta
+Reductionops.zeta -> Closure.zeta
+Reductionops.betaiota -> Closure.betaiota
+Reductionops.betaiotazeta -> Closure.betaiotazeta
+Reductionops.delta -> Closure.delta
+Reductionops.betalet -> Closure.betazeta
+Reductionops.betadelta -> Closure.betadeltazeta
+Reductionops.betadeltaiota -> Closure.all
+Reductionops.betadeltaiotanolet -> Closure.allnolet
+Closure.no_red -> Closure.nored
+Reductionops.nored -> Closure.nored
+Reductionops.nf_betadeltaiota -> Reductionops.nf_all
+Reductionops.whd_betadelta -> Reductionops.whd_betadeltazeta
+Reductionops.whd_betadeltaiota -> Reductionops.whd_all
+Reductionops.whd_betadeltaiota_nolet -> Reductionops.whd_allnolet
+Reductionops.whd_betadelta_stack -> Reductionops.whd_betadeltazeta_stack
+Reductionops.whd_betadeltaiota_stack -> Reductionops.whd_all_stack
+Reductionops.whd_betadeltaiota_nolet_stack -> Reductionops.whd_allnolet_stack
+Reductionops.whd_betadelta_state -> Reductionops.whd_betadeltazeta_state
+Reductionops.whd_betadeltaiota_state -> Reductionops.whd_all_state
+Reductionops.whd_betadeltaiota_nolet_state -> Reductionops.whd_allnolet_state
+Reductionops.whd_eta -> Reductionops.shrink_eta
+Tacmach.pf_whd_betadeltaiota -> Tacmach.pf_whd_all
+Tacmach.New.pf_whd_betadeltaiota -> Tacmach.New.pf_whd_all
+
+And removed the following ones:
+
+Reductionops.whd_betaetalet
+Reductionops.whd_betaetalet_stack
+Reductionops.whd_betaetalet_state
+Reductionops.whd_betadeltaeta_stack
+Reductionops.whd_betadeltaeta_state
+Reductionops.whd_betadeltaeta
+Reductionops.whd_betadeltaiotaeta_stack
+Reductionops.whd_betadeltaiotaeta_state
+Reductionops.whd_betadeltaiotaeta
+
+In intf/genredexpr.mli, fIota was replaced by FMatch, FFix and
+FCofix. Similarly, rIota was replaced by rMatch, rFix and rCofix.
+
 ** Notation_ops **
 
 Use Glob_ops.glob_constr_eq instead of Notation_ops.eq_glob_constr.
@@ -30,6 +145,9 @@ val message     : string -> unit
   proper `Feedback.msg_*` function. Clients also have no control over
   flushing, the back end takes care of it.
 
+  Also, the `msg_*` functions now take an optional `?loc` parameter
+  for relaying location to the client.
+
 * Feedback related functions and definitions have been moved to the
   `Feedback` module. `message_level` has been renamed to
   level. Functions moved from Pp to Feedback are:
@@ -41,16 +159,24 @@ val emacs_logger    : logger
 val feedback_logger : logger
 ````
 
+* Changes in the Feedback format/Protocol.
+
+- The `Message` feedback type now carries an optional location, the main
+  payload is encoded using the richpp document format.
+
+- The `ErrorMsg` feedback type is thus unified now with `Message` at
+  level `Error`.
+
 * We now provide several loggers, `log_via_feedback` is removed in
   favor of `set_logger feedback_logger`. Output functions are:
 
 ```` ocaml
 val with_output_to_file : string -> ('a -> 'b) -> 'a -> 'b
-val msg_info    : Pp.std_ppcmds -> unit
-val msg_notice  : Pp.std_ppcmds -> unit
-val msg_warning : Pp.std_ppcmds -> unit
-val msg_error   : Pp.std_ppcmds -> unit
-val msg_debug   : Pp.std_ppcmds -> unit
+val msg_error   : ?loc:Loc.t -> Pp.std_ppcmds -> unit
+val msg_warning : ?loc:Loc.t -> Pp.std_ppcmds -> unit
+val msg_notice  : ?loc:Loc.t -> Pp.std_ppcmds -> unit
+val msg_info    : ?loc:Loc.t -> Pp.std_ppcmds -> unit
+val msg_debug   : ?loc:Loc.t -> Pp.std_ppcmds -> unit
 ````
 
   with the `msg_*` functions being just an alias for `logger $Level`.
@@ -69,6 +195,8 @@ val set_id_for_feedback : ?route:route_id -> edit_or_state_id -> unit
 val get_id_for_feedback : unit -> edit_or_state_id * route_id
 ````
 
+** Kernel API changes **
+
 - The interface of the Context module was changed.
   Related types and functions were put in separate submodules.
   The mapping from old identifiers to new identifiers is the following:
@@ -121,8 +249,8 @@ val get_id_for_feedback : unit -> edit_or_state_id * route_id
 
   Now it is represented as:
 
-    Context.Rel.t = LocalAssum of Names.Name.t * Constr.t
-	          | LocalDef of Names.Name.t * Constr.t * Constr.t
+    Context.Rel.Declaration.t = LocalAssum of Names.Name.t * Constr.t
+	                      | LocalDef of Names.Name.t * Constr.t * Constr.t
  
 - Originally, named-context was represented as:
 
@@ -130,8 +258,8 @@ val get_id_for_feedback : unit -> edit_or_state_id * route_id
 
   Now it is represented as:
 
-    Context.Named.t = LocalAssum of Names.Id.t * Constr.t
-	            | LocalDef of Names.Id.t * Constr.t * Constr.t
+    Context.Named.Declaration.t = LocalAssum of Names.Id.t * Constr.t
+	                        | LocalDef of Names.Id.t * Constr.t * Constr.t
 
 - The various EXTEND macros do not handle specially the Coq-defined entries
   anymore. Instead, they just output a name that have to exist in the scope
@@ -142,12 +270,62 @@ val get_id_for_feedback : unit -> edit_or_state_id * route_id
   for constructing compound entries still works over this scheme. Note that in
   the case of (VERNAC) ARGUMENT EXTEND, the name of the argument entry is bound
   in the parsing rules, so beware of recursive calls.
+  
+  For example, to get "wit_constr" you must "open Constrarg" at the top of the file.
 
 - Evarutil was split in two parts. The new Evardefine file exposes functions
 define_evar_* mostly used internally in the unification engine.
 
 - The Refine module was move out of Proofview.
 
+    Proofview.Refine.* --->  Refine.*
+
+- A statically monotonous evarmap type was introduced in Sigma. Not all the API
+  has been converted, so that the user may want to use compatibility functions
+  Sigma.to_evar_map and Sigma.Unsafe.of_evar_map or Sigma.Unsafe.of_pair when
+  needed. Code can be straightforwardly adapted in the following way:
+
+  let (sigma, x1) = ... in
+  ...
+  let (sigma, xn) = ... in
+  (sigma, ans)
+
+  should be turned into:
+
+  open Sigma.Notations
+
+  let Sigma (x1, sigma, p1) = ... in
+  ...
+  let Sigma (xn, sigma, pn) = ... in
+  Sigma (ans, sigma, p1 +> ... +> pn)
+  
+  Examples of `Sigma.Unsafe.of_evar_map` include:
+  
+  Evarutil.new_evar env (Tacmach.project goal) ty   ----> Evarutil.new_evar env (Sigma.Unsafe.of_evar_map (Tacmach.project goal)) ty
+
+- The Proofview.Goal.*enter family of functions now takes a polymorphic
+  continuation given as a record as an argument.
+
+  Proofview.Goal.enter begin fun gl -> ... end
+
+  should be turned into
+
+  open Proofview.Notations
+
+  Proofview.Goal.enter { enter = begin fun gl -> ... end }
+  
+- `Tacexpr.TacDynamic(Loc.dummy_loc, Pretyping.constr_in c)`      ---> `Tacinterp.Value.of_constr c`
+- `Vernacexpr.HintsResolveEntry(priority, poly, hnf, path, atom)` ---> `Vernacexpr.HintsResolveEntry(Vernacexpr.({hint_priority = priority; hint_pattern = None}), poly, hnf, path, atom)`
+- `Pretyping.Termops.mem_named_context`                           ---> `Engine.Termops.mem_named_context_val`
+  (`Global.named_context`                                         ---> `Global.named_context_val`)
+  (`Context.Named.lookup`                                         ---> `Environ.lookup_named_val`)
+
+** Search API **
+
+The main search functions now take a function iterating over the
+results. This allows for clients to use streaming or more economic
+printing.
+
 =========================================
 = CHANGES BETWEEN COQ V8.4 AND COQ V8.5 =
 =========================================
diff --git a/dev/doc/debugging.txt b/dev/doc/debugging.txt
index f0df2fc37..79cde4884 100644
--- a/dev/doc/debugging.txt
+++ b/dev/doc/debugging.txt
@@ -51,8 +51,8 @@ Debugging from Caml debugger
      failure/error/anomaly has been raised
    - Alternatively, for an error or an anomaly, add breakpoints in the middle  
      of each of error* functions or anomaly* functions in lib/util.ml
-   - If "source db" fails, recompile printers.cma with
-     "make dev/printers.cma" and try again
+   - If "source db" fails, do a "make printers" and try again (it should build
+     top_printers.cmo and the core cma files).
 
 Global gprof-based profiling
 ============================
diff --git a/dev/doc/notes-on-conversion b/dev/doc/notes-on-conversion
index 6274275c9..a81f170c6 100644
--- a/dev/doc/notes-on-conversion
+++ b/dev/doc/notes-on-conversion
@@ -21,7 +21,7 @@ Notation OMEGA := (ack 4 4).
 
 Definition f (x:nat) := x.
 
-(* Evaluation in tactics can somehow be controled *)
+(* Evaluation in tactics can somehow be controlled *)
 Lemma l1 : OMEGA = OMEGA.
 reflexivity.  (* succeed: identity *)
 Qed.          (* succeed: identity *)
diff --git a/dev/doc/ocamlbuild.txt b/dev/doc/ocamlbuild.txt
new file mode 100644
index 000000000..efedbc506
--- /dev/null
+++ b/dev/doc/ocamlbuild.txt
@@ -0,0 +1,30 @@
+Ocamlbuild & Coq
+----------------
+
+A quick note in case someone else gets interested someday in compiling
+Coq via ocamlbuild : such an experimental build system has existed
+in the past (more or less maintained from 2009 to 2013), in addition
+to the official build system via gnu make. But this build via
+ocamlbuild has been severly broken since early 2014 (and don't work
+in 8.5, for instance). This experiment has attracted very limited
+interest from other developers over the years, and has been quite
+cumbersome to maintain, so it is now officially discontinued.
+If you want to have a look at the files of this build system
+(especially myocamlbuild.ml), you can fetch :
+ - my last effort at repairing this build system (up to coqtop.native) :
+   https://github.com/letouzey/coq-wip/tree/ocamlbuild-partial-repair
+ - coq official v8.5 branch (recent but broken)
+ - coq v8.4 branch(less up-to-date, but works).
+
+For the record, the three main drawbacks of this experiments were:
+ - recurrent issues with circularities reported by ocamlbuild
+   (even though make was happy) during the evolution of Coq sources
+ - no proper support of parallel build
+ - quite slow re-traversal of already built things
+See the two corresponding bug reports on Mantis, or
+https://github.com/ocaml/ocamlbuild/issues/52
+
+As an interesting feature, I successfully used this to cross-compile
+Coq 8.4 from linux to win32 via mingw.
+
+Pierre Letouzey, june 2016
diff --git a/dev/doc/profiling.txt b/dev/doc/profiling.txt
new file mode 100644
index 000000000..9d2ebf0d4
--- /dev/null
+++ b/dev/doc/profiling.txt
@@ -0,0 +1,76 @@
+# How to profile Coq?
+
+I (Pierre-Marie Pédrot) mainly use two OCaml branches to profile Coq, whether I
+want to profile time or memory consumption. AFAIK, this only works for Linux.
+
+## Time
+
+In Coq source folder:
+
+opam switch 4.02.1+fp
+./configure -local -debug
+make
+perf record -g bin/coqtop -compile file.v
+perf report -g fractal,callee --no-children
+
+To profile only part of a file, first load it using
+
+bin/coqtop -l file.v
+
+and plug into the process
+
+perf record -g -p PID
+
+## Memory
+
+You first need a few commits atop trunk for this to work.
+
+git remote add ppedrot https://github.com/ppedrot/coq.git
+git fetch ppedrot
+git checkout ppedrot/allocation-profiling
+git rebase master
+
+Then:
+
+opam switch 4.00.1+alloc-profiling
+./configure -local -debug
+make
+
+Note that linking the coqtop binary takes quite an amount of time with this
+branch, so do not worry too much. There are more recent branches of
+alloc-profiling on mshinwell's repo which can be found at:
+
+https://github.com/mshinwell/opam-repo-dev
+
+### For memory dump:
+
+CAMLRUNPARAM=T,mj bin/coqtop -compile file.v
+
+In another terminal:
+
+pkill -SIGUSR1 $COQTOPPID
+...
+pkill -SIGUSR1 $COQTOPPID
+dev/decode-major-heap.sh heap.$COQTOPPID.$N bin/coqtop
+
+where $COQTOPPID is coqtop pid and $N the index of the call to pkill.
+
+First column is the memory taken by the objects (in words), second one is the
+number of objects and third is the place where the objects where allocated.
+
+### For complete memory graph:
+
+CAMLRUNPARAM=T,gr bin/coqtop -compile file.v
+
+In another terminal:
+
+pkill -SIGUSR1 $COQTOPPID
+...
+pkill -SIGUSR1 $COQTOPPID
+ocaml dev/decodegraph.ml edge.$COQTOPPID.$N bin/coqtop > memory.dot
+dot -Tpdf -o memory.pdf memory.dot
+
+where $COQTOPPID is coqtop pid and $N the index of the call to pkill.
+
+The pdf produced by the last command gives a compact graphical representation of
+the various objects allocated.
diff --git a/dev/include b/dev/include
index b2eb280d6..0f43f0072 100644
--- a/dev/include
+++ b/dev/include
@@ -25,7 +25,7 @@
 #cd ".";;
 #use "base_include";;
 
-#install_printer  (* pp_stdcmds *) pppp;;
+#install_printer  (* pp_stdcmds *) pp;;
 
 #install_printer  (* pattern *) pppattern;;
 #install_printer  (* glob_constr *) ppglob_constr;;
@@ -47,7 +47,6 @@
 #install_printer  (* univ full subst *) ppuniverse_level_subst;;
 #install_printer  (* univ opt subst *) ppuniverse_opt_subst;;
 #install_printer  (* evar univ ctx *) ppevar_universe_context;;
-#install_printer  (* constraints_map *) ppconstraints_map;;
 #install_printer  (* inductive *) ppind;;
 #install_printer  (* 'a scheme_kind *) ppscheme;;
 #install_printer  (* type_judgement *) pptype;;
@@ -62,7 +61,7 @@
 (*#install_printer  (* hints_path *)  pphintspath;;*)
 #install_printer  (* goal *)  ppgoal;;
 (*#install_printer  (* sigma goal *)  ppsigmagoal;;*)
-(*#install_printer  (* proof *)  pproof;;*)
+#install_printer  (* proof *)  pproof;;
 #install_printer  (* Goal.goal *)  ppgoalgoal;;
 #install_printer  (* proofview *)  ppproofview;;
 #install_printer  (* metaset.t *) ppmetas;;
diff --git a/dev/make-installer-win32.sh b/dev/make-installer-win32.sh
deleted file mode 100755
index 51d428dd1..000000000
--- a/dev/make-installer-win32.sh
+++ /dev/null
@@ -1,22 +0,0 @@
-#!/bin/sh
-
-set -e
-
-NSIS="$BASE/NSIS/makensis"
-ZIP=_make.zip
-URL1=http://sourceforge.net/projects/gnuwin32/files/make/3.81/make-3.81-bin.zip/download
-URL2=http://sourceforge.net/projects/gnuwin32/files/make/3.81/make-3.81-dep.zip/download
-
-[ -e config/Makefile ] || ./configure -debug -prefix ./ -with-doc no
-make -j2 
-if [ ! -e bin/make.exe ]; then
-  wget -O $ZIP $URL1 && 7z x $ZIP "bin/*"
-  wget -O $ZIP $URL2 && 7z x $ZIP "bin/*"
-  rm -rf $ZIP
-fi
-VERSION=`grep ^VERSION= config/Makefile | cut -d = -f 2`
-cd dev/nsis
-"$NSIS" -DVERSION=$VERSION -DGTK_RUNTIME="`cygpath -w $BASE`" -DARCH="win32" coq.nsi
-echo Installer:
-ls -h $PWD/*exe
-cd ../..
diff --git a/dev/make-installer-win64.sh b/dev/make-installer-win64.sh
deleted file mode 100755
index 438f4ae5b..000000000
--- a/dev/make-installer-win64.sh
+++ /dev/null
@@ -1,28 +0,0 @@
-#!/bin/sh
-
-set -e
-
-NSIS="$BASE/NSIS/makensis"
-ZIP=_make.zip
-URL1=http://sourceforge.net/projects/gnuwin32/files/make/3.81/make-3.81-bin.zip/download
-URL2=http://sourceforge.net/projects/gnuwin32/files/make/3.81/make-3.81-dep.zip/download
-
-[ -e config/Makefile ] || ./configure -debug -prefix ./ -with-doc no
-make -j2 coqide
-mkdir -p bin32
-cp bin/* bin32/
-make clean
-make archclean
-( . ${BASE}_64/environ && ./configure -debug -prefix ./ -with-doc no && make -j2 && make ide/coqidetop.cmxs )
-cp bin32/coqide* bin/
-if [ ! -e bin/make.exe ]; then
-  wget -O $ZIP $URL1 && 7z x $ZIP "bin/*"
-  wget -O $ZIP $URL2 && 7z x $ZIP "bin/*"
-  rm -rf $ZIP
-fi
-VERSION=`grep ^VERSION= config/Makefile | cut -d = -f 2`
-cd dev/nsis
-"$NSIS" -DVERSION=$VERSION -DGTK_RUNTIME="`cygpath -w $BASE`" -DARCH="win64" coq.nsi
-echo Installer:
-ls -h $PWD/*exe
-cd ../..
diff --git a/dev/make-sdk-win32.sh b/dev/make-sdk-win32.sh
deleted file mode 100755
index 0112324d4..000000000
--- a/dev/make-sdk-win32.sh
+++ /dev/null
@@ -1,370 +0,0 @@
-#!/bin/bash
-
-# To run this script install cygwin by running setup-x86.exe from cygwin.com
-# Install the standard packages plus wget.  Then run this script.
-
-# Sworn by Enrico Tassi <enrico.tassi@inra.fr>
-# Modified to support other directories and almost support spaces in paths
-# by Jason Gross <jgross@mit.edu>
-# License: Expat/MIT http://opensource.org/licenses/MIT
-
-# This script reads the following environment variables:
-# VERBOSE     - set to non-empty to have wget/this script be more verbose, for debugging purposes
-# BASE        - set to non-empty to give a different location for the zip file, e.g., if /cygdrive/c is full or doesn't exist
-
-set -e
-if [ ! -z "$VERBOSE" ]
-then
-  set -x
-fi
-
-# Resources
-ocaml=ocaml-4.01.0-i686-mingw64-installer3.exe
-glib=base-windows-0.18.1.1.13.356@BUILD_ec06e9.txz
-gtk=base-gtk-2.24.18.1.58@BUILD_594ca8.txz
-lablgtk=lablgtk-2.18.0.tar.gz
-camlp5=camlp5-6.11.tgz
-nsis=nsis-2.46-setup.exe
-
-ocaml_URL='http://yquem.inria.fr/~protzenk/caml-installer/'$ocaml
-lablgtk_URL='https://forge.ocamlcore.org/frs/download.php/1261/'$lablgtk
-glib_URL='http://dl.arirux.de/5/binaries32/'$glib
-gtk_URL='http://dl.arirux.de/5/binaries32/'$gtk
-camlp5_URL='http://pauillac.inria.fr/~ddr/camlp5/distrib/src/'$camlp5
-nsis_URL='http://netcologne.dl.sourceforge.net/project/nsis/NSIS%202/2.46/'$nsis
-
-cygwin=setup-${HOSTTYPE/i6/x}.exe
-cygwin_URL='http://cygwin.com/'$cygwin
-cygwin_PKGS=p7zip,zip,sed,make,mingw64-i686-gcc-g++,mingw64-i686-gcc-core,mingw64-i686-gcc,patch,rlwrap,libreadline6,diffutils
-
-has_spaces() {
-    test -z "$2"
-}
-# utilities
-# http://www.dependencywalker.com/depends22_x86.zip
-
-# The SDK itself
-REVISION=85-1
-# support for working on computers that don't have a C: drive
-if [ -z "$BASE" ]
-then
-  TRUE_BASE=/cygdrive/c
-else
-  # get absolute path
-  TRUE_BASE="$(readlink -f "$BASE")"
-fi
-BASE="$TRUE_BASE/CoqSDK-$REVISION"
-
-if [ -z "$VERBOSE" ]
-then
-  WGET_ARGS="-N -q"
-else
-  WGET_ARGS="-N"
-fi
-
-# Windows has a version of FIND in C:/Windows/system32/find, and we don't want to use that
-if [ -x /usr/bin/find ]
-then
-  FIND=/usr/bin/find
-else
-  echo "WARNING: /usr/bin/find does not exist.  Falling back on:"
-  which find
-  FIND=find
-fi
-
-WGET_ARGS="-N -q"
-
-if [ "$(has_spaces $BASE; echo $?)" -ne 0 ]; then
-  echo "ERROR: The current base directory ($BASE) has spaces."
-  echo "ERROR: building lablgtk would fail."
-  exit 1
-fi
-
-cyg_install() {
-  if [ ! -e "$cygwin" ]; then wget $WGET_ARGS "$cygwin_URL"; fi
-  chmod a+x "$cygwin"
-  cygstart -w "$cygwin" -q -P $@
-}
-
-sanity_check() {
-  echo "Check: wget."
-  (which wget) || \
-	  (echo "Please install wget using the cygwin installer and retry.";\
-	   exit 1)
-  echo "Check: 7z, gcc.  If it fails wait for cygwin to complete and retry"
-  (which 7z && which i686-w64-mingw32-gcc) || \
-	  (echo "Some cygwin package is not installed.";\
-	   echo "Please wait for cygwin to finish and retry.";\
-	   cyg_install $cygwin_PKGS;\
-	   exit 1)
-}
-
-install_base() {
-  echo "Setting up $BASE"
-  rm -rf "$BASE"
-  mkdir -p "$BASE"
-}
-
-make_environ() {
-  echo "Setting up $BASE/environ"
-  pushd "$BASE" >/dev/null
-  cat > environ <<- EOF
-	cyg_install() {
-	  if [ ! -e "$cygwin" ]; then wget $WGET_ARGS "$cygwin_URL"; fi
-	  chmod a+x "$cygwin"
-	  cygstart -w "$cygwin" -q -P \$@
-	}
-	# Sanity checks: is the mingw64-i686-gcc package installed?
-	(which i686-w64-mingw32-gcc && which make && which sed) || \\
-		(echo "Some cygwin package is not installed.";\\
-	         echo "Please wait for cygwin to finish and retry.";\\
-	 	 cyg_install $cygwin_PKGS;\\
-		 exit 1) || exit 1
-
-	export BASE="\$( cd "\$( dirname "\${BASH_SOURCE[0]}" )" && pwd )"
-	export PATH="\$BASE/bin:\$PATH"
-	export OCAMLLIB="\$(cygpath -m "\$BASE")/lib"
-	export OCAMLFIND_CONF="\$(cygpath -m "\$BASE")/etc/findlib.conf"
-	sed s"|@BASE@|\$(cygpath -m "\$BASE")|g" "\$BASE/lib/ld.conf.in" \\
-	        > "\$BASE/lib/ld.conf"
-	sed s"|@BASE@|\$(cygpath -m "\$BASE")|g" "\$BASE/lib/topfind.in" \\
-	        > "\$BASE/lib/topfind"
-	sed s"|@BASE@|\$(cygpath -m "\$BASE")|g" "\$BASE/etc/findlib.conf.in" \\
-	        > "\$BASE/etc/findlib.conf"
-	echo "Good.  You can now build Coq and Coqide from cygwin."
-	EOF
-  popd >/dev/null
-}
-
-download() {
-  echo "Downloading some software:"
-  if [ ! -e "$ocaml" ]; then
-    echo "- downloading OCaml..."
-    wget $WGET_ARGS "$ocaml_URL"
-  fi
-  chmod a+x "$ocaml"
-  if [ ! -e "$lablgtk" ]; then
-    echo "- downloading lablgtk..."
-    wget $WGET_ARGS --no-check-certificate "$lablgtk_URL"
-  fi
-  if [ ! -e "$gtk" ]; then
-    echo "- downloading gtk..."
-    wget $WGET_ARGS "$gtk_URL"
-  fi
-  if [ ! -e "$glib" ]; then
-    echo "- downloading glib..."
-    wget $WGET_ARGS "$glib_URL"
-  fi
-  if [ ! -e "$camlp5" ]; then
-    echo "- downloading camlp5..."
-    wget $WGET_ARGS "$camlp5_URL"
-  fi
-  if [ ! -e "$nsis" ]; then
-    echo "- downloading nsis..."
-    wget $WGET_ARGS "$nsis_URL"
-  fi
-}
-
-cleanup() {
-  rm -rf tmp build
-}
-
-install_gtk() {
-  echo "Installing $glib"
-  tar -xJf "$glib" -C "$BASE"
-  echo "Installing $gtk"
-  tar -xJf "$gtk" -C "$BASE"
-}
-
-install_ocaml() {
-  echo "Installing $ocaml"
-  mkdir -p tmp
-  7z -otmp x "$ocaml" >/dev/null
-  cp -r tmp/\$_OUTDIR/bin "$BASE/"
-  cp -r tmp/bin "$BASE/"
-  cp -r tmp/\$_OUTDIR/lib "$BASE/"
-  cp -r tmp/lib "$BASE/"
-  cp -r tmp/\$_OUTDIR/etc "$BASE/"
-  "$FIND" "$BASE" -name '*.dll' -o -name '*.exe' | tr '\n' '\0' \
-	  | xargs -0 chmod a+x
-  mv "$BASE/lib/topfind" "$BASE/lib/topfind.in"
-  sed -i 's|@SITELIB@|@BASE@/lib/site-lib|g' "$BASE/lib/topfind.in"
-  cat > "$BASE/lib/ld.conf.in" <<- EOF
-	@BASE@/lib
-	@BASE@/lib/stublibs
-	EOF
-  cat > "$BASE/etc/findlib.conf.in" <<- EOF
-	destdir="@BASE@/lib/site-lib"
-	path="@BASE@/lib/site-lib"
-	stdlib="@BASE@/lib"
-	ldconf="@BASE@/lib/ld.conf"
-	ocamlc="ocamlc.opt"
-	ocamlopt="ocamlopt.opt"
-	ocamldep="ocamldep.opt"
-	ocamldoc="ocamldoc.opt"
-	EOF
-  cp "$BASE/lib/topdirs.cmi" "$BASE/lib/compiler-libs/"
-}
-
-build_install_lablgtk() {
-  echo "Building $lablgtk"
-  mkdir -p build
-  tar -xzf "$lablgtk" -C build
-  cd build/lablgtk-*
-  patch -p1 <<EOT
---- lablgtk-2.18.0/src/glib.mli	2013-10-01 01:31:50.000000000 -0700
-+++ lablgtk-2.18.0.new/src/glib.mli	2013-12-06 11:57:34.203675200 -0800
-@@ -75,6 +75,7 @@
-   type condition = [ \`ERR | \`HUP | \`IN | \`NVAL | \`OUT | \`PRI]
-   type id
-   val channel_of_descr : Unix.file_descr -> channel
-+  val channel_of_descr_socket : Unix.file_descr -> channel
-   val add_watch :
-     cond:condition list -> callback:(condition list -> bool) -> ?prio:int -> channel -> id
-   val remove : id -> unit
---- lablgtk-2.18.0/src/glib.ml	2013-10-01 01:31:50.000000000 -0700
-+++ lablgtk-2.18.0.new/src/glib.ml	2013-12-06 11:57:53.070804800 -0800
-@@ -72,6 +72,8 @@
-   type id
-   external channel_of_descr : Unix.file_descr -> channel
-     = "ml_g_io_channel_unix_new"
-+  external channel_of_descr_socket : Unix.file_descr -> channel
-+    = "ml_g_io_channel_unix_new_socket"
-   external remove : id -> unit = "ml_g_source_remove"
-   external add_watch :
-     cond:condition list -> callback:(condition list -> bool) -> ?prio:int -> channel -> id
---- lablgtk-2.18.0/src/ml_glib.c	2013-10-01 01:31:50.000000000 -0700
-+++ lablgtk-2.18.0.new/src/ml_glib.c	2013-12-10 02:03:33.940371800 -0800
-@@ -25,6 +25,8 @@
- #include <string.h>
- #include <locale.h>
- #ifdef _WIN32
-+/* to kill a #warning: include winsock2.h before windows.h */
-+#include <winsock2.h>
- #include "win32.h"
- #include <wtypes.h>
- #include <io.h>
-@@ -38,6 +40,11 @@
- #include <caml/callback.h>
- #include <caml/threads.h>
-
-+#ifdef _WIN32
-+/* for Socket_val */
-+#include <caml/unixsupport.h>
-+#endif
-+
- #include "wrappers.h"
- #include "ml_glib.h"
- #include "glib_tags.h"
-@@ -325,14 +332,23 @@
-
- #ifndef _WIN32
- ML_1 (g_io_channel_unix_new, Int_val, Val_GIOChannel_noref)
-+CAMLprim value ml_g_io_channel_unix_new_socket (value arg1) {
-+  return Val_GIOChannel_noref (g_io_channel_unix_new (Int_val (arg1)));
-+}
-
- #else
- CAMLprim value ml_g_io_channel_unix_new(value wh)
- {
-   return Val_GIOChannel_noref
--    (g_io_channel_unix_new
-+    (g_io_channel_win32_new_fd
-      (_open_osfhandle((long)*(HANDLE*)Data_custom_val(wh), O_BINARY)));
- }
-+
-+CAMLprim value ml_g_io_channel_unix_new_socket(value wh)
-+{
-+  return Val_GIOChannel_noref
-+    (g_io_channel_win32_new_socket(Socket_val(wh)));
-+}
- #endif
-
- static gboolean ml_g_io_channel_watch(GIOChannel *s, GIOCondition c,
-EOT
-  #sed -i s'/$PKG_CONFIG/"$PKG_CONFIG"/g' configure
-  #sed -i s'/""$PKG_CONFIG""/"$PKG_CONFIG"/g' configure
-  ./configure --disable-gtktest --prefix="$(cygpath -m "$BASE")" \
-	  >log-configure 2>&1
-  sed -i 's?\\?/?g' config.make
-  make >log-make 2>&1
-  make opt >>log-make 2>&1
-  #echo "Testing $lablgtk"
-  #cd src
-  #./lablgtk2 ../examples/calc.ml
-  #./lablgtk2 -all ../examples/calc.ml
-  #cd ..
-  echo "Installing $lablgtk"
-  make install >>log-make 2>&1
-  cd ../..
-}
-
-build_install_camlp5() {
-  echo "Building $camlp5"
-  mkdir -p build
-  tar -xzf "$camlp5" -C build
-  cd build/camlp5-*
-  ./configure >log-configure 2>&1
-  sed -i 's/EXT_OBJ=.obj/EXT_OBJ=.o/' config/Makefile
-  sed -i 's/EXT_LIB=.lib/EXT_LIB=.a/' config/Makefile
-  make world.opt >log-make 2>&1
-  echo "Installing $camlp5"
-  make install >>log-make 2>&1
-  cd ../..
-}
-
-install_nsis() {
-  echo "Installing $nsis"
-  rm -rf tmp
-  mkdir -p tmp
-  7z -otmp x $nsis >/dev/null
-  mkdir "$BASE/NSIS"
-  cp -r tmp/\$_OUTDIR/* "$BASE/NSIS"
-  rm -rf tmp/\$_OUTDIR
-  rm -rf tmp/\$PLUGINSDIR
-  cp -r tmp/* "$BASE/NSIS"
-}
-
-zip_sdk() {
-  echo "Generating CoqSDK-${REVISION}.zip"
-  here="`pwd`"
-  cd "$BASE/.."
-  rm -f "$here/CoqSDK-${REVISION}.zip"
-  zip -q -r "$here/CoqSDK-${REVISION}.zip" "$(basename "$BASE")"
-  cd "$here"
-}
-
-diet_sdk() {
-  rm -rf "$BASE"/+*
-  rm -rf "$BASE"/bin/camlp4*
-  rm -rf "$BASE"/lib/camlp4/
-  rm -rf "$BASE"/lib/site-lib/camlp4/
-}
-
-victory(){
-  echo "Output file: CoqSDK-${REVISION}.zip "\
-	  "(`du -sh CoqSDK-${REVISION}.zip | cut -f 1`)"
-  echo "Usage: unpack and source the environ file at its root"
-}
-
-if [ -z "$1" ]; then
-  sanity_check
-  download
-  cleanup
-  install_base
-  install_nsis
-  install_ocaml
-  install_gtk
-  make_environ
-  . "$BASE/environ"
-  build_install_lablgtk
-  build_install_camlp5
-  diet_sdk
-  make_environ
-  zip_sdk
-  cleanup
-  victory
-else
-  # just one step
-  $1
-fi
diff --git a/dev/nsis/coq.nsi b/dev/nsis/coq.nsi
index e1052b1e1..80da84517 100755
--- a/dev/nsis/coq.nsi
+++ b/dev/nsis/coq.nsi
@@ -83,6 +83,7 @@ FunctionEnd
 Section "Coq" Sec1
 
   SetOutPath "$INSTDIR\"
+  File ${COQ_SRC_PATH}\LICENSE
 
   SetOutPath "$INSTDIR\bin"
   File ${COQ_SRC_PATH}\bin\*.exe
diff --git a/dev/ocamldebug-coq.run b/dev/ocamldebug-coq.run
index f9310e076..26cfcc8ae 100644
--- a/dev/ocamldebug-coq.run
+++ b/dev/ocamldebug-coq.run
@@ -12,13 +12,15 @@
 [ -z "$COQTOP" -a -d "$PWD/kernel" ] && COQTOP=$PWD
 [ -z "$COQTOP" -a -d "$PWD/../kernel" ] && COQTOP=`dirname $PWD`
 
+export CAML_LD_LIBRARY_PATH=$COQTOP/kernel/byterun:$CAML_LD_LIBRARY_PATH
+
 exec $OCAMLDEBUG \
-	-I $CAMLP4LIB \
+	-I $CAMLP4LIB -I +threads \
 	-I $COQTOP \
 	-I $COQTOP/config -I $COQTOP/printing -I $COQTOP/grammar \
-	-I $COQTOP/lib -I $COQTOP/intf -I $COQTOP/kernel \
+	-I $COQTOP/lib -I $COQTOP/intf -I $COQTOP/kernel -I $COQTOP/kernel/byterun \
 	-I $COQTOP/library -I $COQTOP/engine \
-	-I $COQTOP/pretyping -I $COQTOP/parsing \
+	-I $COQTOP/pretyping -I $COQTOP/parsing -I $COQTOP/vernac \
         -I $COQTOP/interp -I $COQTOP/proofs -I $COQTOP/tactics -I $COQTOP/stm \
 	-I $COQTOP/toplevel -I $COQTOP/dev -I $COQTOP/config -I $COQTOP/ltac \
         -I $COQTOP/plugins/cc         -I $COQTOP/plugins/dp \
diff --git a/dev/ocamlopt_shared_os5fix.sh b/dev/ocamlopt_shared_os5fix.sh
deleted file mode 100755
index f7d31ad81..000000000
--- a/dev/ocamlopt_shared_os5fix.sh
+++ /dev/null
@@ -1,29 +0,0 @@
-#/bin/sh
-
-### Temporary fix for production of .cmxs on MacOS 10.5
-
-OCAMLOPT=$1
-CMXS=$2
-
-DIR=`dirname $CMXS`
-BASE=`basename $CMXS .cmxs`
-CMXA=$DIR/$BASE.cmxa
-ARC=$DIR/$BASE.a
-# we assume that all object files are at the same place than the rest
-OBJS=`ar t $ARC | sed -e "s|^|$DIR/|" | grep -v SYMDEF`
-
-$OCAMLOPT -dstartup -linkall -shared -o $CMXS $CMXA
-# Fix1: add a dummy instruction before the caml generic functions
-# Fix2: make all caml generic functions private
-rm -f $CMXS $CMXS.startup.fixed.s
-cat $CMXS.startup.s | sed \
- -e "s/_caml_shared_startup__code_begin:/_caml_shared_startup__code_begin:	ret/" \
- -e "s/.globl	_caml_curry/.private_extern	_caml_curry/" \
- -e "s/.globl	_caml_apply/.private_extern	_caml_apply/" \
- -e "s/.globl	_caml_tuplify/.private_extern	_caml_tuplify/" \
- > $CMXS.startup.fixed.s
-# Recompile fixed startup code
-as -o $CMXS.startup.o $CMXS.startup.fixed.s
-# Build fixed .cmxs (assume all object files are at the same place)
-ld -bundle -flat_namespace -undefined warning -read_only_relocs suppress -o $CMXS $OBJS $CMXS.startup.o
-rm $CMXS.startup.o $CMXS.startup.s $CMXS.startup.fixed.s
\ No newline at end of file
diff --git a/dev/printers.mllib b/dev/printers.mllib
deleted file mode 100644
index 74b42842c..000000000
--- a/dev/printers.mllib
+++ /dev/null
@@ -1,219 +0,0 @@
-Coq_config
-
-Terminal
-Hook
-Canary
-Hashset
-Hashcons
-CSet
-CMap
-Int
-Dyn
-HMap
-Option
-Store
-Exninfo
-Backtrace
-IStream
-Pp_control
-Loc
-CList
-CString
-Tok
-Compat
-Flags
-Control
-Loc
-Serialize
-Stateid
-CObj
-CArray
-CStack
-Util
-Pp
-Ppstyle
-Richpp
-Feedback
-Segmenttree
-Unicodetable
-Unicode
-Errors
-Bigint
-CUnix
-Minisys
-System
-Envars
-Aux_file
-Profile
-Explore
-Predicate
-Rtree
-Heap
-Genarg
-Stateid
-CEphemeron
-Future
-RemoteCounter
-Monad
-
-Names
-Univ
-UGraph
-Esubst
-Uint31
-Sorts
-Evar
-Constr
-Context
-Vars
-Term
-Mod_subst
-Cbytecodes
-Copcodes
-Cemitcodes
-Nativevalues
-Primitives
-Nativeinstr
-Future
-Opaqueproof
-Declareops
-Retroknowledge
-Conv_oracle
-Pre_env
-Nativelambda
-Nativecode
-Nativelib
-Cbytegen
-Environ
-Closure
-Reduction
-Nativeconv
-Type_errors
-Modops
-Inductive
-Typeops
-Fast_typeops
-Indtypes
-Cooking
-Term_typing
-Subtyping
-Mod_typing
-Nativelibrary
-Safe_typing
-Unionfind
-
-Summary
-Nameops
-Libnames
-Globnames
-Global
-Nametab
-Libobject
-Lib
-Loadpath
-Goptions
-Decls
-Heads
-Keys
-Locusops
-Miscops
-Universes
-Termops
-Namegen
-UState
-Evd
-Sigma
-Glob_ops
-Redops
-Pretype_errors
-Evarutil
-Reductionops
-Inductiveops
-Arguments_renaming
-Nativenorm
-Retyping
-Cbv
-
-Evardefine
-Evarsolve
-Recordops
-Evarconv
-Typing
-Patternops
-Constr_matching
-Find_subterm
-Tacred
-Classops
-Typeclasses_errors
-Logic_monad
-Proofview_monad
-Proofview
-Ftactic
-Geninterp
-Typeclasses
-Detyping
-Indrec
-Program
-Coercion
-Cases
-Pretyping
-Unification
-Declaremods
-Library
-States
-
-Genprint
-CLexer
-Ppextend
-Pputils
-Ppannotation
-Stdarg
-Constrarg
-Constrexpr_ops
-Genintern
-Notation_ops
-Notation
-Dumpglob
-Syntax_def
-Smartlocate
-Topconstr
-Reserve
-Impargs
-Implicit_quantifiers
-Constrintern
-Modintern
-Constrextern
-Goal
-Miscprint
-Logic
-Refiner
-Clenv
-Evar_refiner
-Proof_errors
-Refine
-Proof
-Proof_global
-Pfedit
-Decl_mode
-Ppconstr
-Pcoq
-Printer
-Pptactic
-Ppdecl_proof
-Egramml
-Egramcoq
-Tacsubst
-Trie
-Dn
-Btermdn
-Hints
-Himsg
-Cerrors
-Locality
-Assumptions
-Vernacinterp
-Dischargedhypsmap
-Discharge
-Declare
-Ind_tables
-Top_printers
diff --git a/dev/top_printers.ml b/dev/top_printers.ml
index 6074acea4..4fcad8820 100644
--- a/dev/top_printers.ml
+++ b/dev/top_printers.ml
@@ -29,8 +29,7 @@ let _ = set_bool_option_value ["Printing";"Matching"] false
 let _ = Detyping.set_detype_anonymous (fun _ _ -> raise Not_found)
 
 (* std_ppcmds *)
-let pp   x = Feedback.msg_notice x
-let pppp x = Feedback.msg_notice x
+let pp   x = Pp.pp_with !Pp_control.std_ft x
 
 (** Future printer *)
 
@@ -80,7 +79,7 @@ let ppconstr_univ x = Constrextern.with_universes ppconstr x
 let ppglob_constr = (fun x -> pp(pr_lglob_constr x))
 let pppattern = (fun x -> pp(pr_constr_pattern x))
 let pptype = (fun x -> try pp(pr_ltype x) with e -> pp (str (Printexc.to_string e)))
-let ppfconstr c = ppconstr (Closure.term_of_fconstr c)
+let ppfconstr c = ppconstr (CClosure.term_of_fconstr c)
 
 let ppbigint n = pp (str (Bigint.to_string n));;
 
@@ -201,7 +200,8 @@ let pppftreestate p = pp(print_pftreestate p)
 (* 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 pproof p = pp(Proof.pr_proof p)
 
 let ppuni u = pp(pr_uni u)
 let ppuni_level u = pp (Level.pr u)
@@ -216,7 +216,6 @@ let ppuniverse_subst l = pp (Univ.pr_universe_subst l)
 let ppuniverse_opt_subst l = pp (Universes.pr_universe_opt_subst l)
 let ppuniverse_level_subst l = pp (Univ.pr_universe_level_subst l)
 let ppevar_universe_context l = pp (Evd.pr_evar_universe_context l)
-let ppconstraints_map c = pp (Universes.pr_constraints_map c)
 let ppconstraints c = pp (pr_constraints Level.pr c)
 let ppuniverseconstraints c = pp (Universes.Constraints.pr c)
 let ppuniverse_context_future c = 
@@ -316,7 +315,7 @@ let constr_display csr =
     | Anonymous -> "Anonymous"
 
   in
-  Feedback.msg_notice (str (term_display csr) ++fnl ())
+  pp (str (term_display csr) ++fnl ())
 
 open Format;;
 
@@ -457,7 +456,7 @@ let print_pure_constr csr =
 	print_string (Printexc.to_string e);print_flush ();
 	raise e
 
-let ppfconstr c = ppconstr (Closure.term_of_fconstr c)
+let ppfconstr c = ppconstr (CClosure.term_of_fconstr c)
 
 let pploc x = let (l,r) = Loc.unloc x in
   print_string"(";print_int l;print_string",";print_int r;print_string")"
@@ -479,6 +478,8 @@ let prgenarginfo arg =
 
 let ppgenarginfo arg = pp (prgenarginfo arg)
 
+let ppgenargargt arg = pp (str (Genarg.ArgT.repr arg))
+
 let ppist ist =
   let pr id arg = prgenarginfo arg in
   pp (pridmap pr ist.Geninterp.lfun)
@@ -502,7 +503,7 @@ END
 
 open Pcoq
 open Genarg
-open Constrarg
+open Stdarg
 open Egramml
 
 let _ =
@@ -514,7 +515,7 @@ let _ =
            (fun () -> in_current_context constr_display c)
        | _ -> failwith "Vernac extension: cannot occur")
   with
-    e -> Feedback.msg_notice (Errors.print e)
+    e -> pp (CErrors.print e)
 let _ =
   extend_vernac_command_grammar ("PrintConstr", 0) None
     [GramTerminal "PrintConstr";
@@ -530,7 +531,7 @@ let _ =
            (fun () -> in_current_context print_pure_constr c)
        | _ -> failwith "Vernac extension: cannot occur")
   with
-    e -> Feedback.msg_notice (Errors.print e)
+    e -> pp (CErrors.print e)
 let _ =
   extend_vernac_command_grammar ("PrintPureConstr", 0) None
     [GramTerminal "PrintPureConstr";
diff --git a/doc/common/macros.tex b/doc/common/macros.tex
index df5ee405f..5abdecfc1 100644
--- a/doc/common/macros.tex
+++ b/doc/common/macros.tex
@@ -72,7 +72,8 @@
 %\newcommand{\spec}[1]{\{\,#1\,\}}
 
 % Building regular expressions
-\newcommand{\zeroone}[1]{\mbox{\sl [}#1\mbox{\sl ]}}
+\newcommand{\zeroone}[1]{\mbox{\sl [}{#1}\mbox{\sl ]}}
+\newcommand{\zeroonelax}[1]{\mbox{\sl [}#1\mbox{\sl ]}}
 %\newcommand{\zeroonemany}[1]{$\{$#1$\}$*}
 %\newcommand{\onemany}[1]{$\{$#1$\}$+}
 \newcommand{\nelistnosep}[1]{{#1} \mbox{\dots} {#1}}
diff --git a/doc/common/styles/html/coqremote/cover.html b/doc/common/styles/html/coqremote/cover.html
index 6ec4dc1af..1c415eca6 100644
--- a/doc/common/styles/html/coqremote/cover.html
+++ b/doc/common/styles/html/coqremote/cover.html
@@ -61,6 +61,7 @@
   <li>V8.3 © INRIA 2010-2011</li>
   <li>V8.4 © INRIA 2012-2014</li>
   <li>V8.5 © INRIA 2015-2016</li>
+  <li>V8.6 © INRIA 2016</li>
 </ul>
 
 <p style="text-indent:0pt">This research was partly supported by IST
diff --git a/doc/common/styles/html/simple/cover.html b/doc/common/styles/html/simple/cover.html
index 328bd68da..25fb56320 100644
--- a/doc/common/styles/html/simple/cover.html
+++ b/doc/common/styles/html/simple/cover.html
@@ -39,6 +39,7 @@
   <li>V8.3 © INRIA 2010-2011</li>
   <li>V8.4 © INRIA 2012-2014</li>
   <li>V8.5 © INRIA 2015-2016</li>
+  <li>V8.6 © INRIA 2016</li>
 </ul>
 
 <p style="text-indent:0pt">This research was partly supported by IST
diff --git a/doc/faq/FAQ.tex b/doc/faq/FAQ.tex
index 48b61827d..213fb0313 100644
--- a/doc/faq/FAQ.tex
+++ b/doc/faq/FAQ.tex
@@ -2587,8 +2587,8 @@ 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
+A dependent type is a type which depends on some term. For instance
+``vector of size n'' is a dependent type representing all the vectors
 of size $n$. Its type depends on $n$
 
 \Question{What is a proof by reflection?}
diff --git a/doc/faq/fk.bib b/doc/faq/fk.bib
index 4d90efcdb..3410427de 100644
--- a/doc/faq/fk.bib
+++ b/doc/faq/fk.bib
@@ -2171,7 +2171,7 @@ Decomposition}},
 @Misc{ProofGeneral,
   author =	 {David Aspinall},
   title =	 {Proof General},
-  note =	 {\url{http://proofgeneral.inf.ed.ac.uk/}}
+  note =	 {\url{https://proofgeneral.github.io/}}
 }
 
 
diff --git a/doc/refman/AsyncProofs.tex b/doc/refman/AsyncProofs.tex
index 7cf500400..7ffe25225 100644
--- a/doc/refman/AsyncProofs.tex
+++ b/doc/refman/AsyncProofs.tex
@@ -46,6 +46,43 @@ proof does not begin with \texttt{Proof using}, the system records in an
 auxiliary file, produced along with the \texttt{.vo} file, the list of
 section variables used.
 
+\section{Proof blocks and error resilience}
+
+Coq 8.6 introduces a mechanism for error resiliency: in interactive mode Coq
+is able to completely check a document containing errors instead of bailing
+out at the first failure.
+
+Two kind of errors are supported: errors occurring in vernacular commands and
+errors occurring in proofs.
+
+To properly recover from a failing tactic, Coq needs to recognize the structure of
+the proof in order to confine the error to a sub proof.  Proof block detection
+is performed by looking at the syntax of the proof script (i.e. also looking at indentation).
+Coq comes with four kind of proof blocks, and an ML API to add new ones.
+
+\begin{description}
+\item[curly] blocks are delimited by \texttt{\{} and \texttt{\}}, see \ref{Proof-handling}
+\item[par] blocks are atomic, i.e. just one tactic introduced by the \texttt{par:} goal selector
+\item[indent] blocks end with a tactic indented less than the previous one
+\item[bullet] blocks are delimited by two equal bullet signs at the same indentation level
+\end{description}
+
+\subsection{Caveats}
+
+When a vernacular command fails the subsequent error messages may be bogus, i.e. caused by
+the first error.  Error resiliency for vernacular commands can be switched off passing
+\texttt{-async-proofs-command-error-resilience off} to CoqIDE.
+
+An incorrect proof block detection can result into an incorrect error recovery and
+hence in bogus errors.  Proof block detection cannot be precise for bullets or
+any other non well parenthesized proof structure.  Error resiliency can be
+turned off or selectively activated for any set of block kind passing to
+CoqIDE one of the following options:
+\texttt{-async-proofs-tactic-error-resilience off},
+\texttt{-async-proofs-tactic-error-resilience all},
+\texttt{-async-proofs-tactic-error-resilience $blocktype_1$,..., $blocktype_n$}.
+Valid proof block types are: ``curly'', ``par'', ``indent'', ``bullet''. 
+
 \subsubsection{Automatic suggestion of proof annotations}
 
 The command \texttt{Set Suggest Proof Using} makes Coq suggest, when a
@@ -85,6 +122,9 @@ reduce the reactivity of the master process to user commands.
 To disable this feature, one can pass the \texttt{-async-proofs off} flag to
 CoqIDE.
 
+Proofs that are known to take little time to process are not delegated to a
+worker process.  The threshold can be configure with \texttt{-async-proofs-delegation-threshold}.  Default is 0.03 seconds.
+
 \section{Batch mode}
 
 When Coq is used as a batch compiler by running \texttt{coqc} or
diff --git a/doc/refman/CanonicalStructures.tex b/doc/refman/CanonicalStructures.tex
index a3372c296..275e1c2d5 100644
--- a/doc/refman/CanonicalStructures.tex
+++ b/doc/refman/CanonicalStructures.tex
@@ -4,7 +4,7 @@
 \label{CS-full}
 \index{Canonical Structures!presentation}
 
-This chapter explains the basics of Canonical Structure and how thy can be used
+\noindent This chapter explains the basics of Canonical Structure and how they can be used
 to overload notations and build a hierarchy of algebraic structures.
 The examples are taken from~\cite{CSwcu}.  We invite the interested reader
 to refer to this paper for all the details that are omitted here for brevity.
diff --git a/doc/refman/Classes.tex b/doc/refman/Classes.tex
index e8ebb9f99..acfc4bea9 100644
--- a/doc/refman/Classes.tex
+++ b/doc/refman/Classes.tex
@@ -9,10 +9,6 @@
 \aauthor{Matthieu Sozeau}
 \label{typeclasses}
 
-\begin{flushleft}
-  \em The status of Type Classes is experimental.
-\end{flushleft}
-
 This chapter presents a quick reference of the commands related to type
 classes. For an actual introduction to type classes, there is a
 description of the system \cite{sozeau08} and the literature on type
@@ -382,6 +378,71 @@ projections as instances. This is almost equivalent to {\tt Hint Resolve
 Declares variables according to the given binding context, which might
 use implicit generalization (see \ref{SectionContext}).
 
+\asubsection{\tt typeclasses eauto}
+\tacindex{typeclasses eauto}
+\label{typeclasseseauto}
+
+The {\tt typeclasses eauto} tactic uses a different resolution engine
+than {\tt eauto} and {\tt auto}. The main differences are the following:
+\begin{itemize}
+\item Contrary to {\tt eauto} and {\tt auto}, the resolution is done
+  entirely in the new proof engine (as of Coq v8.6), meaning that
+  backtracking is available among dependent subgoals, and shelving goals
+  is supported. {\tt typeclasses eauto} is a multi-goal tactic.
+  It analyses the dependencies between subgoals to avoid
+  backtracking on subgoals that are entirely independent.
+\item When called with no arguments, {\tt typeclasses eauto} uses the
+  {\tt typeclass\_instances} database by default (instead of {\tt
+    core}).
+  Dependent subgoals are automatically shelved, and shelved
+  goals can remain after resolution ends (following the behavior of
+  \Coq{} 8.5).
+
+  \emph{Note: } As of Coq 8.6, {\tt all:once (typeclasses eauto)}
+  faithfully mimicks what happens during typeclass resolution when it is
+  called during refinement/type-inference, except that \emph{only}
+  declared class subgoals are considered at the start of resolution
+  during type inference, while ``all'' can select non-class subgoals as
+  well. It might move to {\tt all:typeclasses eauto} in future versions
+  when the refinement engine will be able to backtrack.
+\item When called with specific databases (e.g. {\tt with}), {\tt
+    typeclasses eauto} allows shelved goals to remain at any point
+  during search and treat typeclasses goals like any other.
+\item The transparency information of databases is used consistently for
+  all hints declared in them. It is always used when calling the unifier.
+  When considering the local hypotheses, we use the transparent
+  state of the first hint database given. Using an empty database
+  (created with {\tt Create HintDb} for example) with 
+  unfoldable variables and constants as the first argument of
+  typeclasses eauto hence makes resolution with the local hypotheses use
+  full conversion during unification.
+\end{itemize}
+
+\begin{Variants}
+\item \label{depth} {\tt typeclasses eauto \zeroone{\num}}
+  \emph{Warning:} The semantics for the limit {\num} is different than
+  for {\tt auto}. By default, if no limit is given the search is
+  unbounded. Contrary to {\tt auto}, introduction steps ({\tt intro})
+  are counted, which might result in larger limits being necessary
+  when searching with {\tt typeclasses eauto} than {\tt auto}.
+  
+\item \label{with} {\tt typeclasses eauto with {\ident}$_1$ \ldots {\ident}$_n$}.
+  This variant runs resolution with the given hint databases. It treats
+  typeclass subgoals the same as other subgoals (no shelving of
+  non-typeclass goals in particular).
+\end{Variants}
+
+\asubsection{\tt autoapply {\term} with {\ident}}
+\tacindex{autoapply}
+
+The tactic {\tt autoapply} applies a term using the transparency
+information of the hint database {\ident}, and does \emph{no} typeclass
+resolution. This can be used in {\tt Hint Extern}'s for typeclass
+instances (in hint db {\tt typeclass\_instances}) to
+allow backtracking on the typeclass subgoals created by the lemma
+application, rather than doing type class resolution locally at the hint
+application time.
+
 \subsection{\tt Typeclasses Transparent, Opaque {\ident$_1$ \ldots \ident$_n$}}
 \comindex{Typeclasses Transparent}
 \comindex{Typeclasses Opaque}
@@ -400,20 +461,123 @@ abbreviate a type, like {\tt relation A := A -> A -> Prop}.
 
 This is equivalent to {\tt Hint Transparent,Opaque} {\ident} {\tt: typeclass\_instances}.
 
+\subsection{\tt Set Typeclasses Dependency Order}
+\optindex{Typeclasses Dependency Order}
+
+This option (on by default since 8.6) respects the dependency order between
+subgoals, meaning that subgoals which are depended on by other subgoals 
+come first, while the non-dependent subgoals were put before the
+dependent ones previously (Coq v8.5 and below). This can result in quite
+different performance behaviors of proof search.
+
+\subsection{\tt Set Typeclasses Filtered Unification}
+\optindex{Typeclasses Filtered Unification}
+
+This option, available since Coq 8.6 and off by default, switches the
+hint application procedure to a filter-then-unify strategy. To apply a
+hint, we first check that the goal \emph{matches} syntactically the
+inferred or specified pattern of the hint, and only then try to
+\emph{unify} the goal with the conclusion of the hint. This can
+drastically improve performance by calling unification less often,
+matching syntactic patterns being very quick. This also provides more
+control on the triggering of instances.  For example, forcing a constant
+to explicitely appear in the pattern will make it never apply on a goal
+where there is a hole in that place.
+
+\subsection{\tt Set Typeclasses Legacy Resolution}
+\optindex{Typeclasses Legacy Resolution}
+
+This option (off by default) uses the 8.5 implementation of resolution.
+Use for compatibility purposes only (porting and debugging).
+
+\subsection{\tt Set Typeclasses Module Eta}
+\optindex{Typeclasses Modulo Eta}
+
+This option allows eta-conversion for functions and records during
+unification of type-classes. This option is now unsupported in 8.6 with
+{\tt Typeclasses Filtered Unification} set, but still affects the
+default unification strategy, and the one used in {\tt Legacy
+  Resolution} mode. It is \emph{unset} by default. If {\tt Typeclasses
+  Filtered Unification} is set, this has no effect and unification will
+find solutions up-to eta conversion. Note however that syntactic
+pattern-matching is not up-to eta.
+
+\subsection{\tt Set Typeclasses Limit Intros}
+\optindex{Typeclasses Limit Intros}
+
+This option (on by default in Coq 8.6 and below) controls the ability to
+apply hints while avoiding (functional) eta-expansions in the generated
+proof term. It does so by allowing hints that conclude in a product to
+apply to a goal with a matching product directly, avoiding an
+introduction. \emph{Warning:} this can be expensive as it requires
+rebuilding hint clauses dynamically, and does not benefit from the
+invertibility status of the product introduction rule, resulting in
+potentially more expensive proof-search (i.e. more useless
+backtracking).
+
+\subsection{\tt Set Typeclass Resolution After Apply}
+\optindex{Typeclasses Resolution After Apply}
+\emph{Deprecated since 8.6}
+
+This option (off by default in Coq 8.6 and 8.5) controls the resolution
+of typeclass subgoals generated by the {\tt apply} tactic.
+
+\subsection{\tt Set Typeclass Resolution For Conversion}
+\optindex{Typeclasses Resolution For Conversion}
+
+This option (on by default) controls the use of typeclass resolution
+when a unification problem cannot be solved during
+elaboration/type-inference. With this option on, when a unification
+fails, typeclass resolution is tried before launching unification once again.
+
+\subsection{\tt Set Typeclasses Strict Resolution}
+\optindex{Typeclasses Strict Resolution}
+
+Typeclass declarations introduced when this option is set have a
+stricter resolution behavior (the option is off by default). When
+looking for unifications of a goal with an instance of this class, we
+``freeze'' all the existentials appearing in the goals, meaning that
+they are considered rigid during unification and cannot be instantiated.
+
+\subsection{\tt Set Typeclasses Unique Solutions}
+\optindex{Typeclasses Unique Solutions}
+
+When a typeclass resolution is launched we ensure that it has a single
+solution or fail. This ensures that the resolution is canonical, but can
+make proof search much more expensive.
+
+\subsection{\tt Set Typeclasses Unique Instances}
+\optindex{Typeclasses Unique Instances}
+
+Typeclass declarations introduced when this option is set have a
+more efficient resolution behavior (the option is off by default). When
+a solution to the typeclass goal of this class is found, we never
+backtrack on it, assuming that it is canonical.
+
 \subsection{\tt Typeclasses eauto := [debug] [dfs | bfs] [\emph{depth}]}
 \comindex{Typeclasses eauto}
 \label{TypeclassesEauto}
 
-This command allows customization of the type class resolution tactic,
-based on a variant of eauto. The flags semantics are:
+This command allows more global customization of the type class
+resolution tactic.
+The semantics of the options are:
 \begin{itemize}
 \item {\tt debug} In debug mode, the trace of successfully applied
   tactics is printed.
 \item {\tt dfs, bfs} This sets the search strategy to depth-first search
   (the default) or breadth-first search.
-\item {\emph{depth}} This sets the depth of the search (the default is 100).
+\item {\emph{depth}} This sets the depth limit of the search.
 \end{itemize}
 
+\subsection{\tt Set Typeclasses Debug [Verbosity {\num}]}
+\optindex{Typeclasses Debug}
+\optindex{Typeclasses Debug Verbosity}
+
+These options allow to see the resolution steps of typeclasses that are
+performed during search. The {\tt Debug} option is synonymous to 
+{\tt Debug Verbosity 1}, and {\tt Debug Verbosity 2} provides more
+information (tried tactics, shelving of goals, etc\ldots).
+
 \subsection{\tt Set Refine Instance Mode}
 \optindex{Refine Instance Mode}
 
diff --git a/doc/refman/Extraction.tex b/doc/refman/Extraction.tex
index a963662f6..01dbcfb1c 100644
--- a/doc/refman/Extraction.tex
+++ b/doc/refman/Extraction.tex
@@ -3,7 +3,7 @@
 \aauthor{Jean-Christophe Filliâtre and Pierre Letouzey}
 \index{Extraction}
 
-We present here the \Coq\ extraction commands, used to build certified
+\noindent We present here the \Coq\ extraction commands, used to build certified
 and relatively efficient functional programs, extracting them from
 either \Coq\ functions or \Coq\ proofs of specifications. The
 functional languages available as output are currently \ocaml{},
@@ -30,7 +30,7 @@ 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
+\item {\tt Extraction \qualid{}.} ~\par
   Extraction of a constant or module in the \Coq\ toplevel.
 
 \item {\tt Recursive Extraction} \qualid$_1$ \dots\ \qualid$_n$. ~\par
@@ -40,7 +40,7 @@ extraction. They both display extracted term(s) inside \Coq.
 
 %% TODO error messages
 
-All the following commands produce real ML files. User can choose to produce
+\noindent All the following commands produce real ML files. User can choose to produce
 one monolithic file or one file per \Coq\ library. 
 
 \begin{description}
@@ -76,7 +76,7 @@ one monolithic file or one file per \Coq\ library.
   using prefixes \verb!coq_!  or \verb!Coq_!.
 \end{description}
 
-The list of globals \qualid$_i$ does not need to be
+\noindent The list of globals \qualid$_i$ does not need to be
 exhaustive: it is automatically completed into a complete and minimal
 environment. 
 
@@ -215,7 +215,7 @@ arguments. In fact, an argument can also be referred by a number
 indicating its position, starting from 1.
 \end{description}
 
-When an actual extraction takes place, an error is normally raised if the
+\noindent When an actual extraction takes place, an error is normally raised if the
 {\tt Extraction Implicit}
 declarations cannot be honored, that is if any of the implicited
 variables still occurs in the final code. This behavior can be relaxed
@@ -260,7 +260,7 @@ what ML term corresponds to a given axiom.
   be inlined everywhere instead of being declared via a let.
 \end{description}
 
-Note that the {\tt Extract Inlined Constant} command is sugar
+\noindent 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 axiom.
@@ -279,7 +279,7 @@ 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
+\noindent 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 have to be given. The syntax is then:
 
@@ -287,7 +287,7 @@ variables have to be given. The syntax is then:
 \item{\tt Extract Constant \qualid\ \str$_1$ \dots\ \str$_n$ => \str.}
 \end{description}
 
-The number of type variables is checked by the system. 
+\noindent The number of type variables is checked by the system. 
 
 \Example
 \begin{coq_example*}
@@ -295,7 +295,7 @@ 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
+\noindent 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
@@ -325,7 +325,7 @@ native boolean type instead of \Coq\ one.  The syntax is the following:
   pattern-matching of the language will be used.
 \end{description}
 
-For an inductive type with $k$ constructor, the function used to
+\noindent For an inductive type with $k$ constructor, the function used to
 emulate the match should expect $(k+1)$ arguments, first the $k$
 branches in functional form, and then the inductive element to
 destruct. For instance, the match branch \verb$| S n => foo$ gives the
@@ -365,7 +365,7 @@ Extract Inductive bool => "bool" [ "true" "false" ].
 Extract Inductive sumbool => "bool" [ "true" "false" ].
 \end{coq_example}
 
-If an inductive constructor or type has arity 2 and the corresponding 
+\noindent If an inductive constructor or type has arity 2 and the corresponding 
 string is enclosed by parenthesis, then the rest of the string is used
 as infix constructor or type. 
 \begin{coq_example}
@@ -373,7 +373,7 @@ Extract Inductive list => "list" [ "[]" "(::)" ].
 Extract Inductive prod => "(*)"  [ "(,)" ].
 \end{coq_example}
 
-As an example of translation to a non-inductive datatype, let's turn
+\noindent As an example of translation to a non-inductive datatype, let's turn
 {\tt nat} into Ocaml's {\tt int} (see caveat above):
 \begin{coq_example}
 Extract Inductive nat => int [ "0" "succ" ]
@@ -402,7 +402,7 @@ It is possible to instruct the extraction not to use particular filenames.
   Allow the extraction to use any filename.
 \end{description}
 
-For Ocaml, a typical use of these commands is
+\noindent For Ocaml, a typical use of these commands is
 {\tt Extraction Blacklist String List}.
 
 \asection{Differences between \Coq\ and ML type systems}
@@ -448,7 +448,7 @@ let dp x y f = Pair ((Obj.magic f () x), (Obj.magic f () y))
     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.
+Inductive anything : Type := dummy : forall A:Set, A -> anything.
 \end{verbatim}
 
 which corresponds to the definition of an ML dynamic type.
@@ -456,7 +456,7 @@ In Ocaml, we must cast any argument of the constructor dummy.
 
 \end{itemize}
 
-Even with those unsafe castings, you should never get error like
+\noindent 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 
@@ -489,7 +489,7 @@ Inductive nat : Set :=
   | S : nat -> nat.
 \end{coq_example*}
 
-This module contains a theorem {\tt eucl\_dev}, whose type is
+\noindent This module contains a theorem {\tt eucl\_dev}, whose type is
 \begin{verbatim}
 forall b:nat, b > 0 -> forall a:nat, diveucl a b
 \end{verbatim}
@@ -506,7 +506,7 @@ Extraction Inline gt_wf_rec lt_wf_rec induction_ltof2.
 Recursive Extraction eucl_dev.
 \end{coq_example}
 
-The inlining of {\tt gt\_wf\_rec} and others is not
+\noindent The inlining of {\tt gt\_wf\_rec} and others 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: 
@@ -515,7 +515,7 @@ You can then copy-paste the output to a file {\tt euclid.ml} or let
 Extraction "euclid" eucl_dev.
 \end{verbatim}
 
-Let us play the resulting program:
+\noindent Let us play the resulting program:
 
 \begin{verbatim}
 # #use "euclid.ml";;
@@ -543,7 +543,7 @@ val div : int -> int -> int * int = <fun>
 - : int * int = (11, 8)
 \end{verbatim}
 
-Note that these {\tt nat\_of\_int} and {\tt int\_of\_nat} are now
+\noindent Note that these {\tt nat\_of\_int} and {\tt int\_of\_nat} are now
 available via a mere {\tt Require Import ExtrOcamlIntConv} and then
 adding these functions to the list of functions to extract. This file
 {\tt ExtrOcamlIntConv.v} and some others in {\tt plugins/extraction/}
@@ -551,7 +551,7 @@ are meant to help building concrete program via extraction.
 
 \asubsection{Extraction's horror museum}
 
-Some pathological examples of extraction are grouped in the file
+Some pathological examples of extraction are grouped in the file\\
 {\tt test-suite/success/extraction.v} of the sources of \Coq.
 
 \asubsection{Users' Contributions}
@@ -579,7 +579,7 @@ extraction test:
 \item {\tt stalmarck}
 \end{itemize}
 
-{\tt continuations} and {\tt multiplier} are a bit particular. They are
+\noindent {\tt continuations} and {\tt multiplier} are a bit particular. They are
 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
diff --git a/doc/refman/Micromega.tex b/doc/refman/Micromega.tex
index 1efed6ef7..4daf98f87 100644
--- a/doc/refman/Micromega.tex
+++ b/doc/refman/Micromega.tex
@@ -4,16 +4,19 @@
 
  
 \asection{Short description of the tactics}
-\tacindex{psatz}  \tacindex{lra} 
+\tacindex{psatz}  \tacindex{lra} \tacindex{lia}  \tacindex{nia} \tacindex{nra} 
 \label{sec:psatz-hurry}
 The {\tt Psatz} module ({\tt Require Import Psatz.}) gives access to
 several tactics for solving arithmetic goals over {\tt Z}, {\tt Q}, and
 {\tt R}:\footnote{Support for {\tt nat} and {\tt N} is obtained by
-  pre-processing the goal with the {\tt zify} tactic.}
+  pre-processing the goal with the {\tt zify} tactic.}.
+It also possible to get the tactics for integers by a {\tt Require Import Lia}, rationals {\tt Require Import Lqa} 
+and reals {\tt Require Import Lra}.
 \begin{itemize}
 \item {\tt lia} is a decision procedure for linear integer arithmetic (see Section~\ref{sec:lia});
 \item {\tt nia} is an incomplete proof procedure for integer non-linear arithmetic (see Section~\ref{sec:nia});
-\item {\tt lra} is a decision procedure for linear (real or rational) arithmetic goals (see Section~\ref{sec:lra});
+\item {\tt lra} is a decision procedure for linear (real or rational) arithmetic  (see Section~\ref{sec:lra});
+\item {\tt nra} is an incomplete proof procedure for non-linear (real or rational) arithmetic  (see Section~\ref{sec:nra});
 \item {\tt psatz D n} where {\tt D} is {\tt Z} or {\tt Q} or {\tt R}, and
   {\tt n} is an optional integer limiting the proof search depth is is an
   incomplete proof procedure for non-linear arithmetic. It is based on
@@ -114,36 +117,6 @@ The deductive power of {\tt lra} is the combined deductive power of {\tt ring\_s
 %
 There is also an overlap with the {\tt field} tactic {\emph e.g.}, {\tt x = 10 * x / 10} is solved by {\tt lra}.
 
-\asection{{\tt psatz}: a proof procedure for non-linear arithmetic}
-\label{sec:psatz}
-The {\tt psatz} tactic explores the $\mathit{Cone}$ by increasing degrees -- hence the depth parameter $n$.
-In theory, such a proof search is complete -- if the goal is provable the search eventually stops.
-Unfortunately, the external oracle is using numeric (approximate) optimization techniques that might miss a
-refutation. 
-
-To illustrate the working of the tactic, consider we wish to prove the following Coq goal.
-\begin{coq_eval}
-Require Import ZArith Psatz.
-Open Scope Z_scope.
-\end{coq_eval}
-\begin{coq_example*}
-Goal forall x, -x^2 >= 0 -> x - 1 >= 0 -> False.
-\end{coq_example*}
-\begin{coq_eval}
-intro x; psatz Z 2.
-\end{coq_eval}
-Such a goal is solved by {\tt intro x; psatz Z 2}. The oracle returns the
-cone expression $2 \times (\mathbf{x-1}) + (\mathbf{x-1}) \times
-(\mathbf{x-1}) + \mathbf{-x^2}$ (polynomial hypotheses are printed in
-bold). By construction, this expression belongs to $\mathit{Cone}(\{-x^2,
-x -1\})$. Moreover, by running {\tt ring} we obtain $-1$. By
-Theorem~\ref{thm:psatz}, the goal is valid.
-%
-
-%% \paragraph{The {\tt sos} tactic} -- where {\tt sos} stands for \emph{sum of squares} -- tries to prove that a
-%% single polynomial $p$ is positive by expressing it as a sum of squares \emph{i.e.,} $\sum_{i\in S} p_i^2$.
-%% This amounts to searching for $p$ in the cone without generators \emph{i.e.}, $Cone(\{\})$.
-%
 
 \asection{{\tt lia}: a tactic for linear integer arithmetic}
 \tacindex{lia}
@@ -219,22 +192,61 @@ Our current oracle tries to find an expression $e$ with a small range $[c_1,c_2]
 We generate $c_2 - c_1$ subgoals which contexts are enriched with an equation $e = i$ for $i \in [c_1,c_2]$ and
 recursively search for a proof.
 
-\asection{{\tt nia}: a proof procedure for non-linear integer arithmetic}
-\tacindex{nia}
-\label{sec:nia}
-The {\tt nia} tactic is an {\emph experimental} proof procedure for non-linear  integer arithmetic.
+
+\asection{{\tt nra}: a proof procedure for non-linear arithmetic}
+\tacindex{nra}
+\label{sec:nra}
+The {\tt nra} tactic is an {\emph experimental} proof procedure for non-linear arithmetic.
 %
 The tactic performs a limited amount of non-linear reasoning before running the
-linear prover of {\tt lia}.
+linear prover of {\tt lra}.
 This pre-processing does the following:
 \begin{itemize}
 \item If the context contains an arithmetic expression of the form $e[x^2]$ where $x$ is a
   monomial, the context is enriched with $x^2\ge 0$;
 \item For all pairs of hypotheses $e_1\ge 0$, $e_2 \ge 0$, the context is enriched with $e_1 \times e_2 \ge 0$.
 \end{itemize}
-After pre-processing, the linear prover of {\tt lia} searches for a proof
+After this pre-processing, the linear prover of {\tt lra} searches for a proof
 by abstracting monomials by variables.
 
+\asection{{\tt nia}: a proof procedure for non-linear integer arithmetic}
+\tacindex{nia}
+\label{sec:nia}
+The {\tt nia} tactic is a proof procedure for non-linear  integer arithmetic.
+%
+It performs a pre-processing similar to {\tt nra}. The obtained goal is solved using the linear integer prover {\tt lia}.
+
+\asection{{\tt psatz}: a proof procedure for non-linear arithmetic}
+\label{sec:psatz}
+The {\tt psatz} tactic explores the $\mathit{Cone}$ by increasing degrees -- hence the depth parameter $n$.
+In theory, such a proof search is complete -- if the goal is provable the search eventually stops.
+Unfortunately, the external oracle is using numeric (approximate) optimization techniques that might miss a
+refutation. 
+
+To illustrate the working of the tactic, consider we wish to prove the following Coq goal.
+\begin{coq_eval}
+Require Import ZArith Psatz.
+Open Scope Z_scope.
+\end{coq_eval}
+\begin{coq_example*}
+Goal forall x, -x^2 >= 0 -> x - 1 >= 0 -> False.
+\end{coq_example*}
+\begin{coq_eval}
+intro x; psatz Z 2.
+\end{coq_eval}
+Such a goal is solved by {\tt intro x; psatz Z 2}. The oracle returns the
+cone expression $2 \times (\mathbf{x-1}) + (\mathbf{x-1}) \times
+(\mathbf{x-1}) + \mathbf{-x^2}$ (polynomial hypotheses are printed in
+bold). By construction, this expression belongs to $\mathit{Cone}(\{-x^2,
+x -1\})$. Moreover, by running {\tt ring} we obtain $-1$. By
+Theorem~\ref{thm:psatz}, the goal is valid.
+%
+
+%% \paragraph{The {\tt sos} tactic} -- where {\tt sos} stands for \emph{sum of squares} -- tries to prove that a
+%% single polynomial $p$ is positive by expressing it as a sum of squares \emph{i.e.,} $\sum_{i\in S} p_i^2$.
+%% This amounts to searching for $p$ in the cone without generators \emph{i.e.}, $Cone(\{\})$.
+%
+
 
 
 %%% Local Variables: 
diff --git a/doc/refman/Program.tex b/doc/refman/Program.tex
index 11dd3a051..2fc1c8764 100644
--- a/doc/refman/Program.tex
+++ b/doc/refman/Program.tex
@@ -63,10 +63,27 @@ will be first rewritten to:
   previous one, an inequality is added in the context of the second
   branch. See for example the definition of {\tt div2} below, where the second
   branch is typed in a context where $\forall p, \_ <> S (S p)$.
-  
+
 \item Coercion. If the object being matched is coercible to an inductive
   type, the corresponding coercion will be automatically inserted. This also
   works with the previous mechanism.
+
+\end{itemize}
+
+There are options to control the generation of equalities
+and coercions.
+
+\begin{itemize}
+\item {\tt Unset Program Cases}\optindex{Program Cases} This deactivates
+  the special treatment of pattern-matching generating equalities and
+  inequalities when using \Program\ (it is on by default). All
+  pattern-matchings and let-patterns are handled using the standard
+  algorithm of Coq (see Section~\ref{Mult-match-full}) when this option is
+  deactivated.
+\item {\tt Unset Program Generalized Coercion}\optindex{Program
+    Generalized Coercion} This deactivates the coercion of general
+  inductive types when using \Program\ (the option is on by default).
+  Coercion of subset types and pairs is still active in this case.
 \end{itemize}
 
 \subsection{Syntactic control over equalities}
diff --git a/doc/refman/RefMan-com.tex b/doc/refman/RefMan-com.tex
index 6f8584988..bef0a1686 100644
--- a/doc/refman/RefMan-com.tex
+++ b/doc/refman/RefMan-com.tex
@@ -26,13 +26,13 @@ run by the command {\tt coqtop}.
 They are two different binary images of \Coq: the byte-code one and
 the native-code one (if {\ocaml} provides a native-code compiler
 for your platform, which is supposed in the following). By default,
-\verb!coqc! executes the native-code version; this can be overridden
-using the \verb!-byte! option.
+\verb!coqtop! executes the native-code version; run \verb!coqtop.byte! to
+get the byte-code version.
 
 The byte-code toplevel is based on an {\ocaml}
 toplevel (to allow the dynamic link of tactics).  You can switch to
 the {\ocaml} toplevel with the command \verb!Drop.!, and come back to the
-\Coq~toplevel with the command \verb!Toplevel.loop();;!.
+\Coq~toplevel with the command \verb!Coqloop.loop();;!.
 
 \section{Batch compilation ({\tt coqc})}
 The {\tt coqc} command takes a name {\em file} as argument.  Then it
@@ -199,6 +199,12 @@ The following command-line options are recognized by the commands {\tt
   available for {\tt coqc} only; it is the counterpart of {\tt
     -compile-verbose}.
 
+  \item[{\tt -w} (all|none|w$_1$,\ldots,w$_n$)]\ %
+
+  Configure the display of warnings. This option expects {\tt all}, {\tt none}
+  or a comma-separated list of warning names or categories (see
+  Section~\ref{SetWarnings}).
+
 %Mostly unused in the code
 %\item[{\tt -debug}]\ %
 %
diff --git a/doc/refman/RefMan-ext.tex b/doc/refman/RefMan-ext.tex
index 51e881bff..b475a5233 100644
--- a/doc/refman/RefMan-ext.tex
+++ b/doc/refman/RefMan-ext.tex
@@ -1315,10 +1315,10 @@ command:
 \begin{quote}
 \tt Arguments {\qualid} \nelist{\possiblybracketedident}{}
 \end{quote}
-where the list of {\possiblybracketedident} is the list of all arguments of
-{\qualid} where the ones to be declared implicit are surrounded by
-square brackets and the ones to be declared as maximally inserted implicits
-are surrounded by curly braces.
+where the list of {\possiblybracketedident} is a prefix of the list of arguments
+of {\qualid} where the ones to be declared implicit are surrounded by square
+brackets and the ones to be declared as maximally inserted implicits are
+surrounded by curly braces.
 
 After the above declaration is issued, implicit arguments can just (and
 have to) be skipped in any expression involving an application of
@@ -1591,7 +1591,7 @@ Implicit arguments names can be redefined using the following syntax:
 {\tt Arguments {\qualid} \nelist{\name}{}  : rename}
 \end{quote}
 
-Without the {\tt rename} flag, {\tt Arguments} can be used to assert
+With the {\tt assert} flag, {\tt Arguments} can be used to assert
 that a given object has the expected number of arguments and that
 these arguments are named as expected.
 
@@ -1600,7 +1600,7 @@ these arguments are named as expected.
 Arguments p [s t] _ [u] _: rename.
 Check (p r1 (u:=c)).
 Check (p (s:=a) (t:=b) r1 (u:=c) r2).
-Fail Arguments p [s t] _ [w] _.
+Fail Arguments p [s t] _ [w] _ : assert.
 \end{coq_example}
 
 
diff --git a/doc/refman/RefMan-gal.tex b/doc/refman/RefMan-gal.tex
index fcccd9cb4..3814e4403 100644
--- a/doc/refman/RefMan-gal.tex
+++ b/doc/refman/RefMan-gal.tex
@@ -273,6 +273,7 @@ called \CIC). The formal presentation of {\CIC} is given in Chapter
 {\binder} & ::= &   {\name} & (\ref{Binders}) \\
  & $|$ & {\tt (} \nelist{\name}{} {\tt :} {\term} {\tt )} &\\  
  & $|$ & {\tt (} {\name} {\typecstr} {\tt :=} {\term} {\tt )} &\\
+ & $|$ & {\tt '} {\pattern} &\\
 & & &\\
 {\name} & ::= & {\ident} &\\
  & $|$ & {\tt \_} &\\
@@ -410,7 +411,8 @@ bound variable cannot be synthesized by the system, it can be
 specified with the notation {\tt (}\,{\ident}\,{\tt :}\,{\type}\,{\tt
 )}. There is also a notation for a sequence of binding variables
 sharing the same type: {\tt (}\,{\ident$_1$}\ldots{\ident$_n$}\,{\tt
-:}\,{\type}\,{\tt )}.
+:}\,{\type}\,{\tt )}. A binder can also be any pattern prefixed by a quote,
+e.g. {\tt '(x,y)}.
 
 Some constructions allow the binding of a variable to value. This is
 called a ``let-binder''. The entry {\binder} of the grammar accepts
@@ -711,9 +713,9 @@ definition have a special syntax: ``{\tt let fix}~$f$~{\ldots}~{\tt
            {\tt Inductive} \nelist{\inductivebody}{with} {\tt .} \\
  & $|$ & {\tt CoInductive} \nelist{\inductivebody}{with} {\tt .} \\
            & & \\
-{\inductivebody} & ::= & 
-  {\ident} \zeroone{\binders} {\tt :} {\term} {\tt :=} \\
-   && ~~\zeroone{\zeroone{\tt |} \nelist{$\!${\ident}$\!$ \zeroone{\binders} {\typecstrwithoutblank}}{|}} \\
+{\inductivebody} & ::= &
+  {\ident} \zeroone{\binders} {\typecstr} {\tt :=} \\
+   && ~~\zeroone{\zeroone{\tt |} \nelist{$\!${\ident}$\!$ \zeroone{\binders} {\typecstr}}{|}} \\
            & & \\  %% TODO: where ...
 %% Fixpoints
 {\fixpoint} & ::= & {\tt Fixpoint} \nelist{\fixpointbody}{with} {\tt .} \\
diff --git a/doc/refman/RefMan-ltac.tex b/doc/refman/RefMan-ltac.tex
index cc7e6b53b..9378529cb 100644
--- a/doc/refman/RefMan-ltac.tex
+++ b/doc/refman/RefMan-ltac.tex
@@ -25,6 +25,8 @@ problems.
 \def\contexthyp{\textrm{\textsl{context\_hyp}}}
 \def\tacarg{\nterm{tacarg}}
 \def\cpattern{\nterm{cpattern}}
+\def\selector{\textrm{\textsl{selector}}}
+\def\toplevelselector{\textrm{\textsl{toplevel\_selector}}}
 
 The syntax of the tactic language is given Figures~\ref{ltac}
 and~\ref{ltac-aux}. See Chapter~\ref{BNF-syntax} for a description of
@@ -78,7 +80,7 @@ For instance
 {\tt try repeat \tac$_1$ ||
   \tac$_2$;\tac$_3$;[\tac$_{31}$|\dots|\tac$_{3n}$];\tac$_4$.}
 \end{quote}
-is understood as 
+is understood as
 \begin{quote}
 {\tt (try (repeat (\tac$_1$ || \tac$_2$)));} \\
 {\tt ((\tac$_3$;[\tac$_{31}$|\dots|\tac$_{3n}$]);\tac$_4$).}
@@ -104,6 +106,7 @@ is understood as
 & | & {\tt exactly\_once} {\tacexprpref}\\
 & | & {\tt timeout} {\it (}{\naturalnumber} {\it |} {\ident}{\it )} {\tacexprpref}\\
 & | & {\tt time} \zeroone{\qstring} {\tacexprpref}\\
+& | & {\tt only} {\selector} {\tt :} {\tacexprpref}\\
 & | & {\tacexprinf} \\
 \\
 {\tacexprinf} & ::= &
@@ -174,7 +177,7 @@ is understood as
 \\
 {\messagetoken}\!\!\!\!\!\! & ::= & {\qstring} ~|~ {\ident} ~|~ {\integer} \\
 \\
-\tacarg & ::= & 
+\tacarg & ::= &
         {\qualid}\\
 & $|$ & {\tt ()} \\
 & $|$ & {\tt ltac :} {\atom}\\
@@ -203,7 +206,18 @@ is understood as
 & $|$ & {\integer} {\tt \,<\,} {\integer}\\
 & $|$ & {\integer} {\tt <=} {\integer}\\
 & $|$ & {\integer} {\tt \,>\,} {\integer}\\
-& $|$ & {\integer} {\tt >=} {\integer}
+& $|$ & {\integer} {\tt >=} {\integer}\\
+\\
+\selector & ::= &
+        [{\ident}]\\
+& $|$ & {\integer}\\
+& $|$ & \nelist{{\it (}{\integer} {\it |} {\integer} {\tt -} {\integer}{\it )}}
+          {\tt ,}\\
+\\
+\toplevelselector & ::= &
+        \selector\\
+& $|$ & {\tt all}\\
+& $|$ & {\tt par}
 \end{tabular}
 \end{centerframe}
 \caption{Syntax of the tactic language (continued)}
@@ -344,7 +358,7 @@ for $=1,...,n$. It fails if the number of focused goals is not exactly $n$.
     expects multiple goals, such as {\tt swap}, would act as if a single
     goal is focused.
 
-  \item {\tacexpr} {\tt ; [ } {\tacexpr}$_1$ {\tt |} $...$ {\tt |} {\tacexpr}$_n$ {\tt ]} 
+  \item {\tacexpr} {\tt ; [ } {\tacexpr}$_1$ {\tt |} $...$ {\tt |} {\tacexpr}$_n$ {\tt ]}
 
     This variant of local tactic application is paired with a
     sequence.  In this variant, $n$ must be the number of goals
@@ -358,7 +372,58 @@ for $=1,...,n$. It fails if the number of focused goals is not exactly $n$.
 
 \end{Variants}
 
+\subsubsection[Goal selectors]{Goal selectors\label{ltac:selector}
+\tacindex{\tt :}\index{Tacticals!:@{\tt :}}}
+
+We can restrict the application of a tactic to a subset of
+the currently focused goals with:
+\begin{quote}
+  {\toplevelselector} {\tt :} {\tacexpr}
+\end{quote}
+We can also use selectors as a tactical, which allows to use them nested in
+a tactic expression, by using the keyword {\tt only}:
+\begin{quote}
+  {\tt only} {\selector} {\tt :} {\tacexpr}
+\end{quote}
+When selecting several goals, the tactic {\tacexpr} is applied globally to
+all selected goals.
+
+\begin{Variants}
+  \item{} [{\ident}] {\tt :} {\tacexpr}
+
+    In this variant, {\tacexpr} is applied locally to a goal
+    previously named by the user.
+
+  \item {\num} {\tt :} {\tacexpr}
+
+    In this variant, {\tacexpr} is applied locally to the
+    {\num}-th goal.
+
+  \item $n_1$-$m_1$, \dots, $n_k$-$m_k$ {\tt :} {\tacexpr}
+
+    In this variant, {\tacexpr} is applied globally to the subset
+    of goals described by the given ranges. You can write a single
+    $n$ as a shortcut for $n$-$n$ when specifying multiple ranges.
+
+  \item {\tt all:} {\tacexpr}
+
+    In this variant, {\tacexpr} is applied to all focused goals.
+    {\tt all:} can only be used at the toplevel of a tactic expression.
+
+  \item {\tt par:} {\tacexpr}
 
+    In this variant, {\tacexpr} is applied to all focused goals
+    in parallel.  The number of workers can be controlled via the
+    command line option {\tt -async-proofs-tac-j} taking as argument
+    the desired number of workers.  Limitations:  {\tt par: } only works
+    on goals containing no existential variables and {\tacexpr} must
+    either solve the goal completely or do nothing (i.e. it cannot make
+    some progress).
+    {\tt par:} can only be used at the toplevel of a tactic expression.
+
+\end{Variants}
+
+\ErrMsg \errindex{No such goal}
 
 \subsubsection[For loop]{For loop\tacindex{do}
 \index{Tacticals!do@{\tt do}}}
@@ -782,7 +847,7 @@ setting option {\tt Printing All}, see Section~\ref{SetPrintingAll}).
 \begin{coq_example}
 Ltac f x :=
   match x with
-    context f [S ?X] => 
+    context f [S ?X] =>
     idtac X;                    (* To display the evaluation order *)
     assert (p := eq_refl 1 : X=1);    (* To filter the case X=1 *)
     let x:= context f[O] in assert (x=O) (* To observe the context *)
@@ -1026,7 +1091,7 @@ Reset Initial.
 \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 
+{\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.
 Such auxiliary lemma is inlined in the final proof term
@@ -1103,7 +1168,7 @@ using the syntax:
 \end{quote}
 A previous definition of {\qualid} must exist in the environment.
 The new definition will always be used instead of the old one and
-it goes accross module boundaries.
+it goes across module boundaries.
 
 If preceded by the keyword {\tt Local} the tactic definition will not
 be exported outside the current module.
@@ -1116,6 +1181,8 @@ Defined {\ltac} functions can be displayed using the command
 {\tt Print Ltac {\qualid}.}
 \end{quote}
 
+The command {\tt Print Ltac Signatures\comindex{Print Ltac Signatures}} displays a list of all user-defined tactics, with their arguments.
+
 \section{Debugging {\ltac} tactics}
 
 \subsection[Info trace]{Info trace\comindex{Info}\optindex{Info Level}}
@@ -1194,6 +1261,86 @@ s: & continue current evaluation without stopping\\
 r $n$: & advance $n$ steps further\\
 r {\qstring}: & advance up to the next call to ``{\tt idtac} {\qstring}''\\
 \end{tabular}
+
+\subsection[Profiling {\ltac} tactics]{Profiling {\ltac} tactics\optindex{Ltac Profiling}\comindex{Show Ltac Profile}\comindex{Reset Ltac Profile}}
+
+It is possible to measure the time spent in invocations of primitive tactics as well as tactics defined in {\ltac} and their inner invocations. The primary use is the development of complex tactics, which can sometimes be so slow as to impede interactive usage. The reasons for the performence degradation can be intricate, like a slowly performing {\ltac} match or a sub-tactic whose performance only degrades in certain situations. The profiler generates a call tree and indicates the time spent in a tactic depending its calling context. Thus it allows to locate the part of a tactic definition that contains the performance bug.
+
+\begin{quote}
+{\tt Set Ltac Profiling}.
+\end{quote}
+Enables the profiler
+
+\begin{quote}
+{\tt Unset Ltac Profiling}.
+\end{quote}
+Disables the profiler
+
+\begin{quote}
+{\tt Show Ltac Profile}.
+\end{quote}
+Prints the profile
+
+\begin{quote}
+{\tt Show Ltac Profile} {\qstring}.
+\end{quote}
+Prints a profile for all tactics that start with {\qstring}. Append a period (.) to the string if you only want exactly that name.
+
+\begin{quote}
+{\tt Reset Ltac Profile}.
+\end{quote}
+Resets the profile, that is, deletes all accumulated information.  Note that backtracking across a {\tt Reset Ltac Profile} will not restore the information.
+
+\begin{coq_eval}
+Reset Initial.
+\end{coq_eval}
+\begin{coq_example*}
+Require Import Coq.omega.Omega.
+
+Ltac mytauto := tauto.
+Ltac tac := intros; repeat split; omega || mytauto.
+
+Notation max x y := (x + (y - x)) (only parsing).
+\end{coq_example*}
+\begin{coq_example*}
+Goal forall x y z A B C D E F G H I J K L M N O P Q R S T U V W X Y Z,
+    max x (max y z) = max (max x y) z /\ max x (max y z) = max (max x y) z
+    /\ (A /\ B /\ C /\ D /\ E /\ F /\ G /\ H /\ I /\ J /\ K /\ L /\ M /\ N /\ O /\ P /\ Q /\ R /\ S /\ T /\ U /\ V /\ W /\ X /\ Y /\ Z
+        -> Z /\ Y /\ X /\ W /\ V /\ U /\ T /\ S /\ R /\ Q /\ P /\ O /\ N /\ M /\ L /\ K /\ J /\ I /\ H /\ G /\ F /\ E /\ D /\ C /\ B /\ A).
+Proof.
+\end{coq_example*}
+\begin{coq_example}
+  Set Ltac Profiling.
+  tac.
+\end{coq_example}
+{\let\textit\texttt% use tt mode for the output of ltacprof
+\begin{coq_example}
+  Show Ltac Profile.
+\end{coq_example}
+\begin{coq_example}
+  Show Ltac Profile "omega".
+\end{coq_example}
+}
+\begin{coq_example*}
+Abort.
+Unset Ltac Profiling.
+\end{coq_example*}
+
+\tacindex{start ltac profiling}\tacindex{stop ltac profiling}
+The following two tactics behave like {\tt idtac} but enable and disable the profiling. They allow you to exclude parts of a proof script from profiling.
+
+\begin{quote}
+{\tt start ltac profiling}.
+\end{quote}
+
+\begin{quote}
+{\tt stop ltac profiling}.
+\end{quote}
+
+You can also pass the {\tt -profile-ltac} command line option to {\tt coqc}, which performs a {\tt Set Ltac Profiling} at the beginning of each document, and a {\tt Show Ltac Profile} at the end.
+
+Note that the profiler currently does not handle backtracking into multi-success tactics, and issues a warning to this effect in many cases when such backtracking occurs.
+
 \endinput
 
 \subsection{Permutation on closed lists}
@@ -1227,7 +1374,7 @@ 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}
@@ -1553,7 +1700,7 @@ Figure~\ref{isoslem} gives examples of what can be solved by {\tt IsoProve}.
 \begin{center}
 \fbox{\begin{minipage}{0.95\textwidth}
 \begin{coq_example*}
-Lemma isos_ex1 : 
+Lemma isos_ex1 :
   forall A B:Set, A * unit * B = B * (unit * A).
 Proof.
 intros; IsoProve.
@@ -1573,7 +1720,7 @@ Qed.
 \label{isoslem}
 \end{figure}
 
-%%% Local Variables: 
+%%% Local Variables:
 %%% mode: latex
 %%% TeX-master: "Reference-Manual"
-%%% End: 
+%%% End:
diff --git a/doc/refman/RefMan-oth.tex b/doc/refman/RefMan-oth.tex
index aea2bae38..56ce753cd 100644
--- a/doc/refman/RefMan-oth.tex
+++ b/doc/refman/RefMan-oth.tex
@@ -87,7 +87,7 @@ is restored when the current \emph{section} ends.
 \item {\tt Global Unset {\rm\sl flag}.\comindex{Global Unset}}\\
 This command switches {\rm\sl flag} off.  The original state of
 {\rm\sl flag} is \emph{not} restored at the end of the module. Additionally,
-if set in a file, {\rm\sl flag} is switched on when the file is
+if set in a file, {\rm\sl flag} is switched off when the file is
 {\tt Require}-d.
 \end{Variants}
 
@@ -914,6 +914,19 @@ This command turns off the normal displaying.
 \subsection[\tt Unset Silent.]{\tt Unset Silent.\optindex{Silent}}
 This command turns the normal display on.
 
+\subsection[\tt Set Warnings ``(\nterm{w}$_1$,\ldots,%
+  \nterm{w}$_n$)''.]{{\tt Set Warnings ``(\nterm{w}$_1$,\ldots,%
+  \nterm{w}$_n$)''}.\optindex{Warnings}}
+\label{SetWarnings}
+This command configures the display of warnings. It is experimental, and
+expects, between quotes, a comma-separated list of warning names or
+categories. Adding~\texttt{-} in front of a warning or category disables it,
+adding~\texttt{+} makes it an error. It is possible to use the special
+categories \texttt{all} and \texttt{default}, the latter containing the warnings
+enabled by default. The flags are interpreted from left to right, so in case of
+an overlap, the flags on the right have higher priority, meaning that
+\texttt{A,-A} is equivalent to \texttt{-A}.
+
 \subsection[\tt Set Search Output Name Only.]{\tt Set Search Output Name Only.\optindex{Search Output Name Only}
 \label{Search-Output-Name-Only}
 \index{Search Output Name Only mode}}
@@ -947,6 +960,14 @@ time of writing this documentation, the default value is 50).
 \subsection[\tt Test Printing Depth.]{\tt Test Printing Depth.\optindex{Printing Depth}}
 This command displays the current nesting depth used for display.
 
+\subsection[\tt Set Printing Dependent Evars Line.]{\tt Set Printing Dependent Evars Line.\optindex{Printing Dependent Evars Line}}
+This command enables the printing of the ``{\tt (dependent evars: \ldots)}''
+line when {\tt -emacs} is passed.
+
+\subsection[\tt Unset Printing Dependent Evars Line.]{\tt Unset Printing Dependent Evars Line.\optindex{Printing Dependent Evars Line}}
+This command disables the printing of the ``{\tt (dependent evars: \ldots)}''
+line when {\tt -emacs} is passed.
+
 %\subsection{\tt Abstraction ...}
 %Not yet documented.
 
diff --git a/doc/refman/RefMan-pre.tex b/doc/refman/RefMan-pre.tex
index cb2ab5dc2..f36969e82 100644
--- a/doc/refman/RefMan-pre.tex
+++ b/doc/refman/RefMan-pre.tex
@@ -1087,6 +1087,139 @@ Paris, January 2015, revised December 2015,\\
 Hugo Herbelin, Matthieu Sozeau and the {\Coq} development team\\
 \end{flushright}
 
+\section*{Credits: version 8.6}
+
+{\Coq} version 8.6 contains the result of refinements, stabilization of
+8.5's features and cleanups of the internals of the system. Over the
+year of (now time-based) development, about 450 bugs were resolved and
+over 100 contributions integrated. The main user visible changes are:
+\begin{itemize}
+\item A new, faster state-of-the-art universe constraint checker, by
+  Jacques-Henri Jourdan.
+\item In CoqIDE and other asynchronous interfaces, more fine-grained
+  asynchronous processing and error reporting by Enrico Tassi, making {\Coq}
+  capable of recovering from errors and continue processing the document.
+\item More access to the proof engine features from Ltac: goal
+  management primitives, range selectors and a {\tt typeclasses
+    eauto} engine handling multiple goals and multiple successes, by
+  Cyprien Mangin, Matthieu Sozeau and Arnaud Spiwack.
+\item Tactic behavior uniformization and specification, generalization
+  of intro-patterns by Hugo Herbelin and others.
+\item A brand new warning system allowing to control warnings, turn them
+  into errors or ignore them selectively by Maxime Dénès, Guillaume
+  Melquiond, Pierre-Marie Pédrot and others.
+\item Irrefutable patterns in abstractions, by Daniel de Rauglaudre.
+\item The {\tt ssreflect} subterm selection algorithm by Georges Gonthier and
+  Enrico Tassi is now accessible to tactic writers through the {\tt ssrmatching}
+  plugin.
+\item Integration of {\tt LtacProf}, a profiler for {\tt Ltac} by Jason
+  Gross, Paul Steckler, Enrico Tassi and Tobias Tebbi.
+\end{itemize}
+
+{\Coq} 8.6 also comes with a bunch of smaller-scale changes and
+improvements regarding the different components of the system. We shall
+only list a few of them.
+
+The {\tt iota} reduction flag is now a shorthand for {\tt match}, {\tt
+  fix} and {\tt cofix} flags controlling the corresponding reduction
+rules (by Hugo Herbelin and Maxime Dénès).
+
+Maxime Dénès maintained the native compilation machinery.
+
+Pierre-Marie Pédrot separated the Ltac code from general purpose
+tactics, and generalized and rationalized the handling of generic
+arguments, allowing to create new versions of Ltac more easily in the
+future.
+
+In patterns and terms, {\tt @}, abbreviations and notations are now
+interpreted the same way, by Hugo Herbelin.
+
+Name handling for universes has been improved by Pierre-Marie Pédrot and
+Matthieu Sozeau. The minimization algorithm has been improved by
+Matthieu Sozeau.
+
+The unifier has been improved by Hugo Herbelin and Matthieu Sozeau,
+fixing some incompatibilities introduced in Coq 8.5. Unification
+constraints can now be left floating around and be seen by the user
+thanks to a new option. The {\tt Keyed Unification} mode has been
+improved by Matthieu Sozeau. 
+
+The typeclass resolution engine and associated proof-search tactic have
+been reimplemented on top of the proof-engine monad, providing better
+integration in tactics, and new options have been introduced to control
+it, by Matthieu Sozeau with help from Théo Zimmermann.
+
+The efficiency of the whole system has been significantly improved
+thanks to contributions from Pierre-Marie Pédrot, Maxime Dénès and
+Matthieu Sozeau and performance issue tracking by Jason Gross and Paul
+Steckler.
+
+Standard library improvements by Jason Gross, Sébastien Hinderer, Pierre
+Letouzey and others.
+
+Emilio Jesús Gallego Arias contributed many cleanups and refactorings of
+the pretty-printing and user interface communication components.
+
+Frédéric Besson maintained the micromega tactic.
+
+The OPAM repository for {\Coq} packages has been maintained by Guillaume
+Claret, Guillaume Melquiond, Matthieu Sozeau, Enrico Tassi and others. A
+list of packages is now available at \url{https://coq.inria.fr/opam/www/}.
+
+Packaging tools and software development kits were prepared by Michael
+Soegtrop with the help of Maxime Dénès and Enrico Tassi for Windows, and
+Maxime Dénès and Matthieu Sozeau for MacOS X. Packages are now regularly
+built on the continuous integration server. {\Coq} now comes with a {\tt
+  META} file usable with {\tt ocamlfind}, contributed by Emilio Jesús
+Gallego Arias, Gregory Malecha, and Matthieu Sozeau.
+
+Matej Košík maintained and greatly improved the continuous integration
+setup and the testing of {\Coq} contributions. He also contributed many
+API improvement and code cleanups throughout the system.
+
+The contributors for this version are Bruno Barras, C.J. Bell, Yves
+Bertot, Frédéric Besson, Pierre Boutillier, Tej Chajed, Guillaume
+Claret, Xavier Clerc, Pierre Corbineau, Pierre Courtieu, Maxime Dénès,
+Ricky Elrod, Emilio Jesús Gallego Arias, Jason Gross, Hugo Herbelin,
+Sébastien Hinderer, Jacques-Henri Jourdan, Matej Kosik, Xavier Leroy,
+Pierre Letouzey, Gregory Malecha, Cyprien Mangin, Erik Martin-Dorel,
+Guillaume Melquiond, Clément Pit--Claudel, Pierre-Marie Pédrot, Daniel
+de Rauglaudre, Lionel Rieg, Gabriel Scherer, Thomas Sibut-Pinote,
+Matthieu Sozeau, Arnaud Spiwack, Paul Steckler, Enrico Tassi, Laurent
+Théry, Nickolai Zeldovich and Théo Zimmermann. The development process
+was coordinated by Hugo Herbelin and Matthieu Sozeau with the help of
+Maxime Dénès, who was also in charge of the release process.
+
+Many power users helped to improve the design of the new features via
+the bug tracker, the pull request system, the {\Coq} development mailing
+list or the coq-club mailing list. Special thanks to the users who
+contributed patches and intensive brain-storming and code reviews,
+starting with Cyril Cohen, Jason Gross, Robbert Krebbers, Jonathan
+Leivent, Xavier Leroy, Gregory Malecha, Clément Pit--Claudel, Gabriel
+Scherer and Beta Ziliani. It would however be impossible to mention
+exhaustively the names of everybody who to some extent influenced the
+development.
+
+Version 8.6 is the first release of {\Coq} developed on a time-based
+development cycle. Its development spanned 10 months from the release of
+{\Coq} 8.5 and was based on a public roadmap. To date, it contains more
+external contributions than any previous {\Coq} system. Code reviews
+were systematically done before integration of new features, with an
+important focus given to compatibility and performance issues, resulting
+in a hopefully more robust release than {\Coq} 8.5.
+
+Coq Enhancement Proposals (CEPs for short) were introduced by Enrico
+Tassi to provide more visibility and a discussion period on new
+features, they are publicly available \url{https://github.com/coq/ceps}.
+
+Started during this period, an effort is led by Yves Bertot and Maxime
+Dénès to put together a {\Coq} consortium.
+
+\begin{flushright}
+Paris, November 2016,\\
+Matthieu Sozeau and the {\Coq} development team\\
+\end{flushright}
+
 
 %new Makefile
 
diff --git a/doc/refman/RefMan-syn.tex b/doc/refman/RefMan-syn.tex
index 1f08b6a2f..21c39de96 100644
--- a/doc/refman/RefMan-syn.tex
+++ b/doc/refman/RefMan-syn.tex
@@ -321,6 +321,10 @@ Sometimes, a notation is expected only for the parser.
 To do so, the option {\em only parsing} is allowed in the list of modifiers of
 \texttt{Notation}.
 
+Conversely, the {\em only printing} can be used to declare
+that a notation should only be used for printing and should not declare a
+parsing rule. In particular, such notations do not modify the parser.
+
 \subsection{The \texttt{Infix} command
 \comindex{Infix}}
 
@@ -480,6 +484,7 @@ Locate "exists _ .. _ , _".
   & $|$ & {\ident} {\tt global} \\
   & $|$ & {\ident} {\tt bigint} \\
   & $|$ & {\tt only parsing} \\
+  & $|$ & {\tt only printing} \\
   & $|$ & {\tt format} {\str} 
 \end{tabular}
 \end{centerframe}
@@ -584,6 +589,14 @@ Notation "[| t * ( x , y , .. , z ) ; ( a , b , .. , c )  * u |]" :=
   (t at level 39).
 \end{coq_example*}
 
+Recursive patterns can occur several times on the right-hand side.
+Here is an example:
+
+\begin{coq_example*}
+Notation "[> a , .. , b <]" :=
+  (cons a .. (cons b nil) .., cons b .. (cons a nil) ..).
+\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}).
@@ -629,7 +642,16 @@ empty. Here is an example of recursive notation with closed binders:
 \begin{coq_example*}
 Notation "'mylet' f x .. y :=  t 'in' u":=
   (let f := fun x => .. (fun y => t) .. in u)
-  (x closed binder, y closed binder, at level 200, right associativity).
+  (at level 200, x closed binder, y closed binder, right associativity).
+\end{coq_example*}
+
+A recursive pattern for binders can be used in position of a recursive
+pattern for terms. Here is an example:
+
+\begin{coq_example*}
+Notation "'FUNAPP' x .. y , f" :=
+  (fun x => .. (fun y => (.. (f x) ..) y ) ..)
+  (at level 200, x binder, y binder, right associativity).
 \end{coq_example*}
 
 \subsection{Summary}
@@ -789,13 +811,13 @@ constant have to be interpreted in a given scope. The command is
 \begin{quote}
 {\tt Arguments} {\qualid} \nelist{\name {\tt \%}\scope}{}
 \end{quote}
-where the list is the list of the arguments of {\qualid} eventually
-annotated with their {\scope}. Grouping round parentheses can
-be used to decorate multiple arguments with the same scope.
-{\scope} can be either a scope name or its delimiting key. For example
-the following command puts the first two arguments of {\tt plus\_fct}
-in the scope delimited by the key {\tt F} ({\tt Rfun\_scope}) and the
-last argument in the scope delimited by the key {\tt R} ({\tt R\_scope}).
+where the list is a prefix of the list of the arguments of {\qualid} eventually
+annotated with their {\scope}. Grouping round parentheses can be used to
+decorate multiple arguments with the same scope.  {\scope} can be either a scope
+name or its delimiting key. For example the following command puts the first two
+arguments of {\tt plus\_fct} in the scope delimited by the key {\tt F} ({\tt
+  Rfun\_scope}) and the last argument in the scope delimited by the key {\tt R}
+({\tt R\_scope}).
 
 \begin{coq_example*}
 Arguments plus_fct (f1 f2)%F x%R.
diff --git a/doc/refman/RefMan-tac.tex b/doc/refman/RefMan-tac.tex
index 54450fe7d..3f1241186 100644
--- a/doc/refman/RefMan-tac.tex
+++ b/doc/refman/RefMan-tac.tex
@@ -42,19 +42,17 @@ language will be described in Chapter~\ref{TacticLanguage}.
 \index{tactic@{\tac}}}
 
 A tactic is applied as an ordinary command. It may be preceded by a
-goal selector: {\tt all} if the tactic is to be applied to every
-focused goal simultaneously, or a natural number $n$ if it is to be
-applied to the $n$-th goal. If no selector is specified, the default
+goal selector (see Section \ref{ltac:selector}).
+If no selector is specified, the default
 selector (see Section \ref{default-selector}) is used.
 
-\newcommand{\selector}{\nterm{selector}}
+\newcommand{\toplevelselector}{\nterm{toplevel\_selector}}
 \begin{tabular}{lcl}
-{\selector} & := & {\tt all} | {\num}\\
-{\commandtac} & ::= & {\selector} {\tt :} {\tac} {\tt .}\\
+{\commandtac} & ::= & {\toplevelselector} {\tt :} {\tac} {\tt .}\\
  & $|$ & {\tac} {\tt .}
 \end{tabular}
-\subsection[\tt Set Default Goal Selector ``\selector''.]
-           {\tt Set Default Goal Selector ``\selector''.
+\subsection[\tt Set Default Goal Selector ``\toplevelselector''.]
+           {\tt Set Default Goal Selector ``\toplevelselector''.
             \optindex{Default Goal Selector}
             \label{default-selector}}
 After using this command, the default selector -- used when no selector
@@ -63,7 +61,9 @@ initial value is $1$, hence the tactics are, by default, applied to
 the first goal. Using {\tt Set Default Goal Selector ``all''} will
 make is so that tactics are, by default, applied to every goal
 simultaneously. Then, to apply a tactic {\tt tac} to the first goal
-only, you can write {\tt 1:tac}.
+only, you can write {\tt 1:tac}. Although more selectors are available,
+only {\tt ``all''} or a single natural number are valid default
+goal selectors.
 
 \subsection[\tt Test Default Goal Selector.]
            {\tt Test Default Goal Selector.}
@@ -114,7 +114,7 @@ following syntax:
 \begin{tabular}{lcl}
 {\occclause} & ::= & {\tt in} {\occgoalset} \\
 {\occgoalset} & ::= &
-    \zeroone{{\ident$_1$} \zeroone{\atoccurrences} {\tt ,} \\
+    \zeroonelax{{\ident$_1$} \zeroone{\atoccurrences} {\tt ,} \\
 &   & {\dots} {\tt ,}\\
 &   & {\ident$_m$} \zeroone{\atoccurrences}}\\
 &   & \zeroone{{\tt |-} \zeroone{{\tt *} \zeroone{\atoccurrences}}}\\
@@ -263,6 +263,16 @@ Defined.
 
   This tactic behaves like {\tt refine}, but it does not shelve any
   subgoal. It does not perform any beta-reduction either.
+\item {\tt notypeclasses refine \term}\tacindex{notypeclasses refine}
+
+  This tactic behaves like {\tt refine} except it performs typechecking
+  without resolution of typeclasses.
+
+\item {\tt simple notypeclasses refine \term}\tacindex{simple
+    notypeclasses refine}
+
+  This tactic behaves like {\tt simple refine} except it performs typechecking
+  without resolution of typeclasses.
 \end{Variants}
 
 \subsection{\tt apply \term}
@@ -292,7 +302,7 @@ Section~\ref{pattern} to transform the goal so that it gets the form
 {\tt (fun $x$ => $Q$)~$u_1$~\ldots~$u_n$}.
 
 \begin{ErrMsgs}
-\item \errindex{Impossible to unify \dots\ with \dots}
+\item \errindex{Unable to unify \dots\ with \dots}
 
   The {\tt apply}
   tactic failed to match the conclusion of {\term} and the current goal.
@@ -1278,7 +1288,7 @@ in the list of subgoals remaining to prove.
 
   In particular, \texttt{pose proof {\term} as {\ident}} behaves as
   \texttt{assert ({\ident} := {\term})} and \texttt{pose proof {\term}
-    as {\intropattern}\tacindex{pose proof}} is the same as applying
+    as {\intropattern}} is the same as applying
   the {\intropattern} to {\term}.
 
 \item \texttt{enough ({\ident} :\ {\form})}\tacindex{enough}
@@ -1491,10 +1501,10 @@ the local context.
 \tacindex{contradiction}
 
 This tactic applies to any goal. The {\tt contradiction} tactic
-attempts to find in the current context (after all {\tt intros}) one
-hypothesis that 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}.
+attempts to find in the current context (after all {\tt intros}) an
+hypothesis that is equivalent to an empty inductive type (e.g. {\tt
+  False}), to the negation of a singleton inductive type (e.g. {\tt
+  True} or {\tt x=x}), or two contradictory hypotheses.
 
 \begin{ErrMsgs}
 \item \errindex{No such assumption}
@@ -2280,6 +2290,21 @@ hypothesis.
 
 \end{Variants}
 
+\optindex{Structural Injection}
+
+It is possible to ensure that \texttt{injection {\term}} erases the
+original hypothesis and leaves the generated equalities in the context
+rather than putting them as antecedents of the current goal, as if
+giving \texttt{injection {\term} as} (with an empty list of names). To
+obtain this behavior, the option {\tt Set Structural Injection} must
+be activated. This option is off by default.
+
+By default, \texttt{injection} only creates new equalities between
+terms whose type is in sort \texttt{Type} or \texttt{Set}, thus
+implementing a special behavior for objects that are proofs
+of a statement in \texttt{Prop}.  This behavior can be turned off
+by setting the option \texttt{Set Keep Proof Equalities}.
+\optindex{Keep Proof Equalities}
 \subsection{\tt inversion \ident}
 \tacindex{inversion}
 
@@ -2299,6 +2324,14 @@ latter is first introduced in the local context using
 stock the lemmas whenever the same instance needs to be inverted
 several times. See Section~\ref{Derive-Inversion}.
 
+\Rem Part of the behavior of the \texttt{inversion} tactic is to generate
+equalities between expressions that appeared in the hypothesis that is
+being processed.  By default, no equalities are generated if they relate
+two proofs (i.e. equalities between terms whose type is in
+sort \texttt{Prop}).  This behavior can be turned off by using the option
+\texttt{Set Keep Proof Equalities.}
+\optindex{Keep Proof Equalities}
+
 \begin{Variants}
 \item \texttt{inversion \num}
 
@@ -2872,6 +2905,9 @@ activated, {\tt subst} also deals with the following corner cases:
     subst} would be necessary to replace {\ident$_2$} by $t$ or $t'$
   respectively.
 
+\item The presence of a recursive equation which without the option
+  would be a cause of failure of {\tt subst}.
+  
 \item A context with cyclic dependencies as with hypotheses {\tt
   \ident$_1$ = f~\ident$_2$} and {\tt \ident$_2$ = g~\ident$_1$} which
   without the option would be a cause of failure of {\tt subst}.
@@ -3030,8 +3066,10 @@ $\beta$ (reduction of functional application), $\delta$ (unfolding of
 transparent constants, see \ref{Transparent}), $\iota$ (reduction of
 pattern-matching over a constructed term, and unfolding of {\tt fix}
 and {\tt cofix} expressions) and $\zeta$ (contraction of local
-definitions), the flag are either {\tt beta}, {\tt delta}, {\tt iota}
-or {\tt zeta}. The {\tt delta} flag itself can be refined into {\tt
+definitions), the flags are either {\tt beta}, {\tt delta},
+{\tt match}, {\tt fix}, {\tt cofix}, {\tt iota} or {\tt zeta}.
+The {\tt iota} flag is a shorthand for {\tt match}, {\tt fix} and {\tt cofix}.
+The {\tt delta} flag itself can be refined into {\tt
 delta [\qualid$_1$\ldots\qualid$_k$]} or {\tt delta
 -[\qualid$_1$\ldots\qualid$_k$]}, restricting in the first case the
 constants to unfold to the constants listed, and restricting in the
@@ -3279,6 +3317,16 @@ reduced to \texttt{S t}.
 
 \end{Variants}
 
+\begin{quote}
+\optindex{Refolding Reduction}
+{\tt Refolding Reduction}
+\end{quote}
+
+This option (off by default) controls the use of the refolding strategy
+of {\tt cbn} while doing reductions in unification, type inference and
+tactic applications. It can result in expensive unifications, as
+refolding currently uses a potentially exponential heuristic.
+
 \subsection{\tt unfold \qualid}
 \tacindex{unfold}
 \label{unfold}
@@ -3451,12 +3499,11 @@ hints of the database named {\tt core}.
   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.
+  database.
 
 \item {\tt auto with *}
 
-  Uses all existing hint databases, minus the special database
-  {\tt v62}. See Section~\ref{Hints-databases}
+  Uses all existing hint databases. See Section~\ref{Hints-databases}
 
 \item \texttt{auto using} \nterm{lemma}$_1$ {\tt ,} {\ldots} {\tt ,} \nterm{lemma}$_n$
 
@@ -3465,9 +3512,17 @@ hints of the database named {\tt core}.
   $lemma_i$ is an inductive type, it is the collection of its
   constructors which is added as hints.
 
-\item \texttt{auto using} \nterm{lemma}$_1$ {\tt ,} {\ldots} {\tt ,} \nterm{lemma}$_n$ with \ident$_1$ {\ldots} \ident$_n$
+\item {\tt info\_auto}
 
-  This combines the effects of the {\tt using} and {\tt with} options.
+  Behaves like {\tt auto} but shows the tactics it uses to solve the goal.
+  This variant is very useful for getting a better understanding of automation,
+  or to know what lemmas/assumptions were used.
+
+\item {\tt \zeroone{info\_}auto \zeroone{\num}} \zeroone{{\tt using} \nterm{lemma}$_1$
+  {\tt ,} {\ldots} {\tt ,} \nterm{lemma}$_n$} \zeroone{{\tt with}
+  \ident$_1$ {\ldots} \ident$_n$}
+
+  This is the most general form, combining the various options.
 
 \item {\tt trivial}\tacindex{trivial}
 
@@ -3479,6 +3534,14 @@ hints of the database named {\tt core}.
 
 \item \texttt{trivial with *}
 
+\item \texttt{trivial using} \nterm{lemma}$_1$ {\tt ,} {\ldots} {\tt ,} \nterm{lemma}$_n$
+
+\item {\tt info\_trivial}
+
+\item {\tt \zeroone{info\_}trivial} \zeroone{{\tt using} \nterm{lemma}$_1$
+  {\tt ,} {\ldots} {\tt ,} \nterm{lemma}$_n$} \zeroone{{\tt with}
+  \ident$_1$ {\ldots} \ident$_n$}
+
 \end{Variants}
 
 \Rem {\tt auto} either solves completely the goal or else leaves it
@@ -3492,8 +3555,8 @@ intact. \texttt{auto} and \texttt{trivial} never fail.
 
 This tactic generalizes {\tt auto}. While {\tt auto} does not try
 resolution hints which would leave existential variables in the goal,
-{\tt eauto} does try them (informally speaking, it uses {\tt eapply}
-where {\tt auto} uses {\tt apply}).
+{\tt eauto} does try them (informally speaking, it uses
+{\tt simple eapply} where {\tt auto} uses {\tt simple apply}).
 As a consequence, {\tt eauto} can solve such a goal:
 
 \begin{coq_eval}
@@ -3508,8 +3571,17 @@ eauto.
 Abort.
 \end{coq_eval}
 
-Note that {\tt ex\_intro} should be declared as an
-hint.
+Note that {\tt ex\_intro} should be declared as a hint.
+
+\begin{Variants}
+
+\item {\tt \zeroone{info\_}eauto \zeroone{\num}} \zeroone{{\tt using} \nterm{lemma}$_1$
+  {\tt ,} {\ldots} {\tt ,} \nterm{lemma}$_n$} \zeroone{{\tt with}
+  \ident$_1$ {\ldots} \ident$_n$}
+
+  The various options for eauto are the same as for auto.
+
+\end{Variants}
 
 \SeeAlso Section~\ref{Hints-databases}
 
@@ -3655,19 +3727,22 @@ command to add a hint to some databases \ident$_1$, \dots, \ident$_n$ is
 The {\hintdef} is one of the following expressions:
 
 \begin{itemize}
-\item {\tt Resolve \term}
+\item {\tt Resolve \term {\zeroone{{\tt |} \zeroone{\num} \zeroone{\pattern}}}}
   \comindex{Hint Resolve}
 
   This command adds {\tt simple 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 simple apply {\term}}.
+  the number of subgoals generated by {\tt simple apply {\term}} or \num
+  if specified. The associated pattern is inferred from the conclusion
+  of the type of \term or the given \pattern if specified.
 %{\tt auto} actually uses a slightly modified variant of {\tt simple apply} with use_metas_eagerly_in_conv_on_closed_terms set to false
 
-  % Is it really needed?
-  %% 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 however be reduced to a type starting with a product,
-  %% the tactic {\tt apply {\term}} is also stored in the hints list.
+  In case the inferred type of \term\ does not start with a product
+  the tactic added in the hint list is {\tt exact {\term}}.
+% Actually, a slightly restricted version is used (no conversion on the head symbol)
+  In case
+  this type can however be reduced to a type starting with a product,
+  the tactic {\tt simple apply {\term}} is also stored in the hints list.
 
   If the inferred type of \term\ contains a dependent quantification
   on a variable which occurs only in the premisses of the type and not
@@ -3697,6 +3772,17 @@ The {\hintdef} is one of the following expressions:
 
     Adds each \texttt{Resolve} {\term$_i$}.
 
+  \item {\tt Resolve -> \term}
+
+    Adds the left-to-right implication of an equivalence as a hint
+    (informally the hint will be used as {\tt apply <- \term},
+    although as mentionned before, the tactic actually used is
+    a restricted version of apply).
+
+  \item {\tt Resolve <- \term}
+
+    Adds the right-to-left implication of an equivalence as a hint.
+
   \end{Variants}
 
 \item \texttt{Immediate {\term}}
@@ -3832,17 +3918,19 @@ Abort.
 \comindex{Hint Cut}
 
   \textit{Warning:} these hints currently only apply to typeclass proof search and
-  the \texttt{typeclasses eauto} tactic.
+  the \texttt{typeclasses eauto} tactic (\ref{typeclasseseauto}).
 
   This command can be used to cut the proof-search tree according to a
   regular expression matching paths to be cut. The grammar for regular
-  expressions is the following:
+  expressions is the following. Beware, there is no operator precedence
+  during parsing, one can check with \texttt{Print HintDb} to verify the
+  current cut expression:
 \[\begin{array}{lcll}
   e & ::= & \ident & \text{ hint or instance identifier } \\
-  & & \texttt{*} & \text{ any hint } \\
+  & & \texttt{\_} & \text{ any hint } \\
   & & e | e' & \text{ disjunction } \\
-  & & e ; e' & \text{ sequence } \\
-  & & ! e & \text{ Kleene star } \\
+  & & e e' & \text{ sequence } \\
+  & & e * & \text{ Kleene star } \\
   & & \texttt{emp} & \text{ empty } \\
   & & \texttt{eps} & \text{ epsilon } \\
   & & \texttt{(} e \texttt{)} & 
@@ -3860,25 +3948,33 @@ is to set the cut expression to $c | e$, the initial cut expression
 being \texttt{emp}.
 
 
-\item \texttt{Mode} {\tt (+ | -)}$^*$ {\qualid}
+\item \texttt{Mode} {\tt (+ | ! | -)}$^*$ {\qualid}
 \label{HintMode}
 \comindex{Hint Mode}
 
 This sets an optional mode of use of the identifier {\qualid}.  When
 proof-search faces a goal that ends in an application of {\qualid} to
 arguments {\tt \term$_1$ \mbox{\dots} \term$_n$}, the mode tells if the
-hints associated to qualid can be applied or not. A mode specification 
-is a list of $n$ {\tt +} or {\tt -} items that specify if an argument is
-to be treated as an input {\tt +} or an output {\tt -} of the
-identifier. For a mode to match a list of arguments, input terms \emph{must
-not} contain existential variables, while outputs can be any term.
-Multiple modes can be declared for a single identifier, in that case 
-only one mode needs to match the arguments for the hints to be applied.
+hints associated to qualid can be applied or not. A mode specification
+is a list of $n$ {\tt +}, {\tt !} or {\tt -} items that specify if an
+argument of the identifier is to be treated as an input ({\tt +}), if
+its head only is an input ({\tt !}) or an output ({\tt -}) of the
+identifier. For a mode to match a list of arguments, input terms and
+input heads \emph{must not} contain existential variables or be
+existential variables respectively, while outputs can be any
+term. Multiple modes can be declared for a single identifier, in that
+case only one mode needs to match the arguments for the hints to be
+applied.
+
+The head of a term is understood here as the applicative head, or the
+match or projection scrutinee's head, recursively, casts being ignored.
 
 {\tt Hint Mode} is especially useful for typeclasses, when one does not
 want to support default instances and avoid ambiguity in
 general. Setting a parameter of a class as an input forces proof-search
-to be driven by that index of the class.
+to be driven by that index of the class, with {\tt !} giving more
+flexibility by allowing existentials to still appear deeper in the index
+but not at its head.
 
 \end{itemize}
 
@@ -3914,8 +4010,8 @@ 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.
+database. At {\Coq} startup, only the {\tt core} database is non empty
+and can be used.
 
 \begin{description}
 
@@ -3950,18 +4046,8 @@ databases are non empty and can be used.
   from the \texttt{Classes} directory.
 \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.
+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 Remove Hints \term$_1$ \mbox{\dots} \term$_n$ :~ \ident$_1$
   \mbox{\dots} \ident$_m$}
@@ -4322,22 +4408,23 @@ vernacular command and printed using {\nobreak {\tt Print Firstorder
 
    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 {\qualid}$_1$ , \dots\ , {\qualid}$_n$ }
    \tacindex{firstorder using}
 
-   Adds lemmas in {\tt auto} hints bases {\qualid}$_1$ \dots\ {\qualid}$_n$
-   to the proof-search environment. If {\qualid}$_i$ refers to an inductive
-   type, it is the collection of its constructors which is added as hints.
+   Adds lemmas {\qualid}$_1$ \dots\ {\qualid}$_n$ to the proof-search
+   environment. If {\qualid}$_i$ refers to an inductive type, it is
+   the collection of its constructors which are added to the
+   proof-search environment.
+
+ \item {\tt firstorder with \ident$_1$ \dots\ \ident$_n$ }
+   \tacindex{firstorder with}
+
+   Adds lemmas from {\tt auto} hint bases \ident$_1$ \dots\ \ident$_n$
+   to the proof-search environment.
 
-\item \texttt{firstorder using {\qualid}$_1$ , \dots\ , {\qualid}$_n$ with \ident$_1$ \dots\ \ident$_n$}
+\item \texttt{firstorder {\tac} using {\qualid}$_1$ , \dots\ , {\qualid}$_n$ with \ident$_1$ \dots\ \ident$_n$}
 
-  This combines the effects of the {\tt using} and {\tt with} options.
+  This combines the effects of the different variants of \texttt{firstorder}.
 
 \end{Variants}
 
@@ -4534,7 +4621,7 @@ 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 \dots}
+\item \errindex{Unable to unify \dots\ with \dots}
 \end{ErrMsgs}
 
 \subsection{\tt symmetry}
diff --git a/doc/refman/RefMan-tus.tex b/doc/refman/RefMan-tus.tex
index 3e2988676..797b0aded 100644
--- a/doc/refman/RefMan-tus.tex
+++ b/doc/refman/RefMan-tus.tex
@@ -1012,7 +1012,7 @@ the different kinds of errors used in \Coq{} :
 
 \fun{val Std.error : string -> 'a}
     {For simple error messages}
-\fun{val Std.errorlabstrm : string -> std\_ppcmds -> 'a}
+\fun{val Std.user_err : ?loc:Loc.t -> 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}
 
diff --git a/doc/refman/RefMan-uti.tex b/doc/refman/RefMan-uti.tex
index c282083b5..9962ce996 100644
--- a/doc/refman/RefMan-uti.tex
+++ b/doc/refman/RefMan-uti.tex
@@ -102,7 +102,7 @@ generator using for instance the command:
 
 This command generates a file \texttt{Makefile} that can be used to
 compile all the sources of the current project. It follows the
-syntax described by the output of \texttt{\% coq\_makefile ----help}.
+syntax described by the output of \texttt{\% coq\_makefile -{}-help}.
 Once the \texttt{Makefile} file has been generated a first time, it
 can be used by the \texttt{make} command to compile part or all of
 the project. Note that once it has been generated once, as soon as
@@ -112,8 +112,8 @@ automatically regenerated by an invocation of \texttt{make}.
 The following command generates a minimal example of
 \texttt{\_CoqProject} file:
 \begin{quotation}
-\texttt{\% \{ echo '-R .} \textit{MyFancyLib} \texttt{' ; find . -name
-  '*.v' -print \} > \_CoqProject}
+\texttt{\% ( echo "-R .\ }\textit{MyFancyLib}\texttt{" ; find .\ -name
+  "*.v" -print ) > \_CoqProject}
 \end{quotation}
 when executed at the root of the directory containing the
 project. Here the \texttt{\_CoqProject} lists all the \texttt{.v} files
@@ -251,7 +251,7 @@ to the \Coq\ toplevel or conversely from the \Coq\ toplevel to some
 files.
 
 {\ProofGeneral} is developed and distributed independently of the
-system \Coq. It is freely available at \verb!proofgeneral.inf.ed.ac.uk!.
+system \Coq. It is freely available at \verb!https://proofgeneral.github.io/!.
 
 
 \section[Module specification]{Module specification\label{gallina}\ttindex{gallina}}
diff --git a/doc/refman/Universes.tex b/doc/refman/Universes.tex
index a08cd1475..36518e6fa 100644
--- a/doc/refman/Universes.tex
+++ b/doc/refman/Universes.tex
@@ -201,7 +201,8 @@ universes and explicitly instantiate polymorphic definitions.
 In the monorphic case, this command declares a new global universe named
 {\ident}. It supports the polymorphic flag only in sections, meaning the
 universe quantification will be discharged on each section definition
-independently.
+independently. One cannot mix polymorphic and monomorphic declarations
+in the same section.
 
 \subsection{\tt Constraint {\ident} {\textit{ord}} {\ident}.
   \comindex{Constraint}
@@ -212,6 +213,7 @@ The order relation can be one of $<$, $\le$ or $=$. If consistent,
 the constraint is then enforced in the global environment. Like
 \texttt{Universe}, it can be used with the \texttt{Polymorphic} prefix
 in sections only to declare constraints discharged at section closing time.
+One cannot declare a global constraint on polymorphic universes.
 
 \begin{ErrMsgs}
 \item \errindex{Undeclared universe {\ident}}.
diff --git a/doc/refman/biblio.bib b/doc/refman/biblio.bib
index 70ee1f41f..e69725838 100644
--- a/doc/refman/biblio.bib
+++ b/doc/refman/biblio.bib
@@ -1199,7 +1199,7 @@ Decomposition}},
 @Misc{ProofGeneral,
   author      = {David Aspinall},
   title       = {Proof General},
-  note        = {\url{http://proofgeneral.inf.ed.ac.uk/}}
+  note        = {\url{https://proofgeneral.github.io/}}
 }
 
 @Book{CoqArt,
diff --git a/doc/stdlib/index-list.html.template b/doc/stdlib/index-list.html.template
index a12983ab8..9216c81fc 100644
--- a/doc/stdlib/index-list.html.template
+++ b/doc/stdlib/index-list.html.template
@@ -21,6 +21,7 @@ through the <tt>Require Import</tt> command.</p>
     theories/Init/Peano.v
     theories/Init/Specif.v
     theories/Init/Tactics.v
+    theories/Init/Tauto.v
     theories/Init/Wf.v
     (theories/Init/Prelude.v)
   </dd>
@@ -203,6 +204,7 @@ through the <tt>Require Import</tt> command.</p>
     (theories/QArith/QArith.v)
     theories/QArith/Qreals.v
     theories/QArith/Qcanon.v
+    theories/QArith/Qcabs.v
     theories/QArith/Qround.v
     theories/QArith/QOrderedType.v
     theories/QArith/Qminmax.v
@@ -614,5 +616,6 @@ through the <tt>Require Import</tt> command.</p>
     theories/Compat/AdmitAxiom.v
     theories/Compat/Coq84.v
     theories/Compat/Coq85.v
+    theories/Compat/Coq86.v
   </dd>
 </dl>
diff --git a/doc/tutorial/Tutorial.tex b/doc/tutorial/Tutorial.tex
index 973a0b75e..0d537256b 100644
--- a/doc/tutorial/Tutorial.tex
+++ b/doc/tutorial/Tutorial.tex
@@ -3,6 +3,7 @@
 \usepackage[utf8]{inputenc}
 \usepackage{textcomp}
 \usepackage{pslatex}
+\usepackage{hyperref}
 
 \input{../common/version.tex}
 \input{../common/macros.tex}
@@ -17,7 +18,7 @@
 
 \chapter*{Getting started}
 
-\Coq\ is a Proof Assistant for a Logical Framework known as the Calculus
+\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
@@ -29,7 +30,7 @@ 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.
+the \Coq{} Reference Manual or the \textit{Coq'Art}, a book by Y.
 Bertot and P. Castéran on practical uses of the \Coq{} system.
 
 Coq can be used from a standard teletype-like shell window but
@@ -39,9 +40,9 @@ and Pcoq.}.
 
 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}.
+which may be obtained from \Coq{} web site \url{https://coq.inria.fr/}.
 
-In the following, we assume that \Coq~ is called from a standard
+In the following, we assume that \Coq{} is called from a standard
 teletype-like shell window. All examples preceded by the prompting
 sequence \verb:Coq < : represent user input, terminated by a
 period. 
@@ -51,10 +52,10 @@ users screen. When used from a graphical user interface such as
 CoqIde, the prompt is not displayed: user input is given in one window
 and \Coq's answers are displayed in a different window.
 
-The sequence of such examples is a valid \Coq~
+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:
+invocation of \Coq{} delivers a message such as:
 
 \begin{small}
 \begin{flushleft}
@@ -67,17 +68,17 @@ Coq <
 \end{flushleft}
 \end{small}
 
-The first line gives a banner stating the precise version of \Coq~
+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 bug-tracking system
-\verb|http://logical.futurs.inria.fr/coq-bugs|
+\url{https://coq.inria.fr/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
+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}
@@ -106,7 +107,7 @@ of the system, called respectively \verb:Prop:, \verb:Set:, and
 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
+You may request \Coq{} to return to you the type of a valid expression by using
 the command \verb:Check::
 
 \begin{coq_eval}
@@ -130,7 +131,7 @@ Check nat.
 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.
+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,
@@ -206,7 +207,7 @@ We may optionally indicate the required type:
 Definition two : nat := S one.
 \end{coq_example}
 
-Actually \Coq~ allows several possible syntaxes:
+Actually \Coq{} allows several possible syntaxes:
 \begin{coq_example}
 Definition three := S two : nat.
 \end{coq_example}
@@ -249,7 +250,7 @@ explicitly the type of the quantified variable. We check:
 Check (forall m:nat, gt m 0).
 \end{coq_example}
 We may revert to the clean state of
-our initial session using the \Coq~ \verb:Reset: command:
+our initial session using the \Coq{} \verb:Reset: command:
 \begin{coq_example}
 Reset Initial.
 \end{coq_example}
@@ -340,7 +341,7 @@ 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
+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}
@@ -414,7 +415,7 @@ 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
+which inspects the global \Coq{} environment, showing the last \verb:n: declared
 notions: 
 \begin{coq_example}
 Inspect 3.
@@ -429,7 +430,7 @@ their value (or proof-term) is omitted.
 \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
+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},
@@ -528,7 +529,7 @@ such a simple tautology. The reason is that we want to keep
 \subsection{Tauto}
 
 A complete tactic for propositional
-tautologies is indeed available in \Coq~ as the \verb:tauto: tactic. 
+tautologies is indeed available in \Coq{} as the \verb:tauto: tactic.
 \begin{coq_example}
 Restart.
 tauto.
@@ -555,7 +556,7 @@ 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.
+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}
@@ -579,7 +580,7 @@ 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::
+of Peirce's law may be proved in \Coq{} using \verb:tauto::
 \begin{coq_example}
 Abort.
 Lemma NNPeirce : ~ ~ (((A -> B) -> A) -> A).
@@ -588,7 +589,7 @@ 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 
+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.
@@ -652,7 +653,7 @@ 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 
+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 
@@ -660,7 +661,7 @@ 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
+polluted our \Coq{} session by declaring the variables
 \verb:n:, \verb:Pos_n:, \verb:A:, \verb:B:, and \verb:C:.
 
 \begin{coq_example}
@@ -714,7 +715,7 @@ Check ex.
 \end{coq_example}
 and the notation \verb+(exists x:D, P x)+ is just concrete syntax for 
 the expression \verb+(ex D (fun x:D => P x))+. 
-Existential quantification is handled in \Coq~ in a similar
+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
@@ -951,7 +952,7 @@ Abort.
 
 \subsection{Equality}
 
-The basic equality provided in \Coq~ is Leibniz equality, noted infix like
+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:
@@ -1208,7 +1209,7 @@ About prim_rec.
 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
+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
@@ -1228,7 +1229,7 @@ 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$:
+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}
@@ -1275,7 +1276,7 @@ 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
+by primitive recursion. The \Coq{} tactic \verb:simpl: can be used for
 this purpose:
 \begin{coq_example}
 simpl.
@@ -1488,7 +1489,7 @@ Set Printing Width 60.
 
 \section{Opening library modules}
 
-When you start \Coq~ without further requirements in the command line,
+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
@@ -1503,9 +1504,9 @@ 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
+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
+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
diff --git a/engine/engine.mllib b/engine/engine.mllib
index 9ce5af819..53cbbd73e 100644
--- a/engine/engine.mllib
+++ b/engine/engine.mllib
@@ -1,9 +1,10 @@
 Logic_monad
-Termops
 Namegen
+Universes
 UState
 Evd
 Sigma
+Termops
 Proofview_monad
 Evarutil
 Proofview
diff --git a/engine/evarutil.ml b/engine/evarutil.ml
index c5dfe3033..13444cb37 100644
--- a/engine/evarutil.ml
+++ b/engine/evarutil.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-open Errors
+open CErrors
 open Util
 open Names
 open Term
@@ -18,6 +18,13 @@ open Environ
 open Evd
 open Sigma.Notations
 
+module RelDecl = Context.Rel.Declaration
+module NamedDecl = Context.Named.Declaration
+
+let safe_evar_info sigma evk =
+  try Some (Evd.find sigma evk)
+  with Not_found -> None
+
 let safe_evar_value sigma ev =
   try Some (Evd.existential_value sigma ev)
   with NotInstantiatedEvar | Not_found -> None
@@ -66,12 +73,14 @@ let rec flush_and_check_evars sigma c =
 
 let rec whd_evar sigma c =
   match kind_of_term c with
-    | Evar ev ->
-        let (evk, args) = ev in
+    | Evar (evk, args) ->
+      begin match safe_evar_info sigma evk with
+      | Some ({ evar_body = Evar_defined c } as info) ->
         let args = Array.map (fun c -> whd_evar sigma c) args in
-        (match safe_evar_value sigma (evk, args) with
-            Some c -> whd_evar sigma c
-          | None -> c)
+        let c = instantiate_evar_array info c args in
+        whd_evar sigma c
+      | _ -> c
+      end
     | Sort (Type u) -> 
       let u' = Evd.normalize_universe sigma u in
 	if u' == u then c else mkSort (Sorts.sort_of_univ u')
@@ -161,13 +170,11 @@ let is_ground_term evd t =
   not (has_undefined_evars evd t)
 
 let is_ground_env evd env =
-  let open Context.Rel.Declaration in
   let is_ground_rel_decl = function
-    | LocalDef (_,b,_) -> is_ground_term evd b
+    | RelDecl.LocalDef (_,b,_) -> is_ground_term evd b
     | _ -> true in
-  let open Context.Named.Declaration in
   let is_ground_named_decl = function
-    | LocalDef (_,b,_) -> is_ground_term evd b
+    | NamedDecl.LocalDef (_,b,_) -> is_ground_term evd b
     | _ -> true in
   List.for_all is_ground_rel_decl (rel_context env) &&
   List.for_all is_ground_named_decl (named_context env)
@@ -192,6 +199,7 @@ let head_evar =
     | Case (_,_,c,_) -> hrec c
     | App (c,_)      -> hrec c
     | Cast (c,_,_)   -> hrec c
+    | Proj (p, c)    -> hrec c
     | _              -> raise NoHeadEvar
   in
   hrec
@@ -248,11 +256,10 @@ let non_instantiated sigma =
 (************************)
 
 let make_pure_subst evi args =
-  let open Context.Named.Declaration in
   snd (List.fold_right
     (fun decl (args,l) ->
       match args with
-        | a::rest -> (rest, (get_id decl, a)::l)
+        | a::rest -> (rest, (NamedDecl.get_id decl, a)::l)
         | _ -> anomaly (Pp.str "Instance does not match its signature"))
     (evar_filtered_context evi) (Array.rev_to_list args,[]))
 
@@ -289,78 +296,101 @@ let make_pure_subst evi args =
  *   we have the property that u and phi(t) are convertible in env.
  *)
 
+let csubst_subst (k, s) c =
+  let rec subst n c = match Constr.kind c with
+  | Rel m ->
+    if m <= n then c
+    else if m - n <= k then Int.Map.find (k - m + n) s
+    else mkRel (m - k)
+  | _ -> Constr.map_with_binders succ subst n c
+  in
+  if k = 0 then c else subst 0 c
+
 let subst2 subst vsubst c =
-  substl subst (replace_vars vsubst c)
+  csubst_subst subst (replace_vars vsubst c)
 
-let push_rel_context_to_named_context env typ =
-  (* compute the instances relative to the named context and rel_context *)
-  let open Context.Named.Declaration in
-  let ids = List.map get_id (named_context env) in
-  let inst_vars = List.map mkVar ids in
-  let inst_rels = List.rev (rel_list 0 (nb_rel env)) in
+let next_ident_away id avoid =
+  let avoid id = Id.Set.mem id avoid in
+  next_ident_away_from id avoid
+
+let next_name_away na avoid =
+  let avoid id = Id.Set.mem id avoid in
+  let id = match na with Name id -> id | Anonymous -> default_non_dependent_ident in
+  next_ident_away_from id avoid
+
+type csubst = int * Constr.t Int.Map.t
+
+let empty_csubst = (0, Int.Map.empty)
+
+type ext_named_context =
+  csubst * (Id.t * Constr.constr) list *
+  Id.Set.t * Context.Named.t
+
+let push_var id (n, s) =
+  let s = Int.Map.add n (mkVar id) s in
+  (succ n, s)
+
+let push_rel_decl_to_named_context decl (subst, vsubst, avoid, nc) =
   let replace_var_named_declaration id0 id decl =
-    let id' = get_id decl in
+    let id' = NamedDecl.get_id decl in
     let id' = if Id.equal id0 id' then id else id' in
     let vsubst = [id0 , mkVar id] in
-    decl |> set_id id' |> map_constr (replace_vars vsubst)
-  in
-  let replace_var_named_context id0 id  env =
-    let nc = Environ.named_context env in
-    let nc' = List.map (replace_var_named_declaration id0 id) nc in
-    Environ.reset_with_named_context (val_of_named_context nc') env
+    decl |> NamedDecl.set_id id' |> NamedDecl.map_constr (replace_vars vsubst)
   in
   let extract_if_neq id = function
     | Anonymous -> None
     | Name id' when id_ord id id' = 0 -> None
     | Name id' -> Some id'
   in
-  (* move the rel context to a named context and extend the named instance *)
-  (* with vars of the rel context *)
-  (* We do keep the instances corresponding to local definition (see above) *)
-  let (subst, vsubst, _, env) =
-    Context.Rel.fold_outside
-      (fun decl (subst, vsubst, avoid, env) ->
-        let open Context.Rel.Declaration in
-        let na = get_name decl in
-	let c = get_value decl in
-	let t = get_type decl in
-        let open Context.Named.Declaration in
-        let id =
-          (* ppedrot: we want to infer nicer names for the refine tactic, but
-             keeping at the same time backward compatibility in other code
-             using this function. For now, we only attempt to preserve the
-             old behaviour of Program, but ultimately, one should do something
-             about this whole name generation problem. *)
-          if Flags.is_program_mode () then next_name_away na avoid
-          else next_ident_away (id_of_name_using_hdchar env t na) avoid
-        in
-        match extract_if_neq id na with
-        | Some id0 when not (is_section_variable id0) ->
-            (* spiwack: if [id<>id0], rather than introducing a new
-               binding named [id], we will keep [id0] (the name given
-               by the user) and rename [id0] into [id] in the named
-               context. Unless [id] is a section variable. *)
-            let subst = List.map (replace_vars [id0,mkVar id]) subst in
-            let vsubst = (id0,mkVar id)::vsubst in
-            let d = match c with
-              | None -> LocalAssum (id0, subst2 subst vsubst t)
-              | Some c -> LocalDef (id0, subst2 subst vsubst c, subst2 subst vsubst t)
-            in
-            let env = replace_var_named_context id0  id env in
-            (mkVar id0 :: subst, vsubst, id::avoid, push_named d env)
-        | _ ->
-            (* spiwack: if [id0] is a section variable renaming it is
-               incorrect. We revert to a less robust behaviour where
-               the new binder has name [id]. Which amounts to the same
-               behaviour than when [id=id0]. *)
-            let d = match c with
-              | None -> LocalAssum (id, subst2 subst vsubst t)
-              | Some c -> LocalDef (id, subst2 subst vsubst c, subst2 subst vsubst t)
-            in
-	    (mkVar id :: subst, vsubst, id::avoid, push_named d env)
-      )
-      (rel_context env) ~init:([], [], ids, env) in
-  (named_context_val env, subst2 subst vsubst typ, inst_rels@inst_vars, subst, vsubst)
+  let na = RelDecl.get_name decl in
+  let id =
+    (* ppedrot: we want to infer nicer names for the refine tactic, but
+        keeping at the same time backward compatibility in other code
+        using this function. For now, we only attempt to preserve the
+        old behaviour of Program, but ultimately, one should do something
+        about this whole name generation problem. *)
+    if Flags.is_program_mode () then next_name_away na avoid
+    else
+      (** id_of_name_using_hdchar only depends on the rel context which is empty
+          here *)
+      next_ident_away (id_of_name_using_hdchar empty_env (RelDecl.get_type decl) na) avoid
+  in
+  match extract_if_neq id na with
+  | Some id0 when not (is_section_variable id0) ->
+      (* spiwack: if [id<>id0], rather than introducing a new
+          binding named [id], we will keep [id0] (the name given
+          by the user) and rename [id0] into [id] in the named
+          context. Unless [id] is a section variable. *)
+      let subst = (fst subst, Int.Map.map (replace_vars [id0,mkVar id]) (snd subst)) in
+      let vsubst = (id0,mkVar id)::vsubst in
+      let d = decl |> NamedDecl.of_rel_decl (fun _ -> id0) |> NamedDecl.map_constr (subst2 subst vsubst) in
+      let nc = List.map (replace_var_named_declaration id0 id) nc in
+      (push_var id0 subst, vsubst, Id.Set.add id avoid, d :: nc)
+  | _ ->
+      (* spiwack: if [id0] is a section variable renaming it is
+          incorrect. We revert to a less robust behaviour where
+          the new binder has name [id]. Which amounts to the same
+          behaviour than when [id=id0]. *)
+      let d = decl |> NamedDecl.of_rel_decl (fun _ -> id) |> NamedDecl.map_constr (subst2 subst vsubst) in
+      (push_var id subst, vsubst, Id.Set.add id avoid, d :: nc)
+
+let push_rel_context_to_named_context env typ =
+  (* compute the instances relative to the named context and rel_context *)
+  let open Context.Named.Declaration in
+  let ids = List.map get_id (named_context env) in
+  let inst_vars = List.map mkVar ids in
+  if List.is_empty (Environ.rel_context env) then
+    (named_context_val env, typ, inst_vars, empty_csubst, [])
+  else
+    let avoid = List.fold_right Id.Set.add ids Id.Set.empty in
+    let inst_rels = List.rev (rel_list 0 (nb_rel env)) in
+    (* move the rel context to a named context and extend the named instance *)
+    (* with vars of the rel context *)
+    (* We do keep the instances corresponding to local definition (see above) *)
+    let (subst, vsubst, _, env) =
+      Context.Rel.fold_outside push_rel_decl_to_named_context
+        (rel_context env) ~init:(empty_csubst, [], avoid, named_context env) in
+    (val_of_named_context env, subst2 subst vsubst typ, inst_rels@inst_vars, subst, vsubst)
 
 (*------------------------------------*
  * Entry points to define new evars   *
@@ -471,27 +501,30 @@ let cleared = Store.field ()
 
 exception Depends of Id.t
 
-let rec check_and_clear_in_constr env evdref err ids c =
+let rec check_and_clear_in_constr env evdref err ids global c =
   (* returns a new constr where all the evars have been 'cleaned'
      (ie the hypotheses ids have been removed from the contexts of
-     evars) *)
-  let check id' =
-    if Id.Set.mem id' ids then
-      raise (ClearDependencyError (id',err))
-  in
+     evars). [global] should be true iff there is some variable of [ids] which
+     is a section variable *)
     match kind_of_term c with
       | Var id' ->
-	  check id'; c
+      if Id.Set.mem id' ids then raise (ClearDependencyError (id', err)) else c
 
       | ( Const _ | Ind _ | Construct _ ) ->
-          let vars = Environ.vars_of_global env c in
-            Id.Set.iter check vars; c
+        let () = if global then
+          let check id' =
+            if Id.Set.mem id' ids then
+              raise (ClearDependencyError (id',err))
+          in
+          Id.Set.iter check (Environ.vars_of_global env c)
+        in
+        c
 
       | Evar (evk,l as ev) ->
 	  if Evd.is_defined !evdref evk then
 	    (* If evk is already defined we replace it by its definition *)
 	    let nc = whd_evar !evdref c in
-	      (check_and_clear_in_constr env evdref err ids nc)
+	      (check_and_clear_in_constr env evdref err ids global nc)
 	  else
 	    (* We check for dependencies to elements of ids in the
 	       evar_info corresponding to e and in the instance of
@@ -518,15 +551,15 @@ let rec check_and_clear_in_constr env evdref err ids c =
                     let () = Id.Map.iter check ri in
                   (* No dependency at all, we can keep this ev's context hyp *)
                     (ri, true::filter)
-                  with Depends id -> let open Context.Named.Declaration in
-                                     (Id.Map.add (get_id h) id ri, false::filter))
+                  with Depends id -> (Id.Map.add (NamedDecl.get_id h) id ri, false::filter))
 		ctxt (Array.to_list l) (Id.Map.empty,[]) in
 	    (* Check if some rid to clear in the context of ev has dependencies
 	       in the type of ev and adjust the source of the dependency *)
 	    let _nconcl =
 	      try
                 let nids = Id.Map.domain rids in
-                check_and_clear_in_constr env evdref (EvarTypingBreak ev) nids (evar_concl evi)
+                let global = Id.Set.exists is_section_variable nids in
+                check_and_clear_in_constr env evdref (EvarTypingBreak ev) nids global (evar_concl evi)
 	      with ClearDependencyError (rid,err) ->
 		raise (ClearDependencyError (Id.Map.find rid rids,err)) in
 
@@ -547,19 +580,19 @@ let rec check_and_clear_in_constr env evdref err ids c =
 	    (* spiwack: /hacking session *)
               whd_evar !evdref c
 
-      | _ -> map_constr (check_and_clear_in_constr env evdref err ids) c
+      | _ -> map_constr (check_and_clear_in_constr env evdref err ids global) c
 
 let clear_hyps_in_evi_main env evdref hyps terms ids =
   (* clear_hyps_in_evi erases hypotheses ids in hyps, checking if some
      hypothesis does not depend on a element of ids, and erases ids in
      the contexts of the evars occurring in evi *)
+  let global = Id.Set.exists is_section_variable ids in
   let terms =
-    List.map (check_and_clear_in_constr env evdref (OccurHypInSimpleClause None) ids) terms in
+    List.map (check_and_clear_in_constr env evdref (OccurHypInSimpleClause None) ids global) terms in
   let nhyps =
-    let open Context.Named.Declaration in
     let check_context decl =
-      let err = OccurHypInSimpleClause (Some (get_id decl)) in
-      map_constr (check_and_clear_in_constr env evdref err ids) decl
+      let err = OccurHypInSimpleClause (Some (NamedDecl.get_id decl)) in
+      NamedDecl.map_constr (check_and_clear_in_constr env evdref err ids global) decl
     in
     let check_value vk = match force_lazy_val vk with
     | None -> vk
@@ -598,8 +631,8 @@ let process_dependent_evar q acc evm is_dependent e =
      hypotheses), they are all dependent. *)
   queue_term q true evi.evar_concl;
   List.iter begin fun decl ->
-    let open Context.Named.Declaration in
-    queue_term q true (get_type decl);
+    let open NamedDecl in
+    queue_term q true (NamedDecl.get_type decl);
     match decl with
     | LocalAssum _ -> ()
     | LocalDef (_,b,_) -> queue_term q true b
@@ -634,6 +667,28 @@ let gather_dependent_evars evm l =
 
 (* /spiwack *)
 
+(** [advance sigma g] returns [Some g'] if [g'] is undefined and is
+    the current avatar of [g] (for instance [g] was changed by [clear]
+    into [g']). It returns [None] if [g] has been (partially)
+    solved. *)
+(* spiwack: [advance] is probably performance critical, and the good
+   behaviour of its definition may depend sensitively to the actual
+   definition of [Evd.find]. Currently, [Evd.find] starts looking for
+   a value in the heap of undefined variable, which is small. Hence in
+   the most common case, where [advance] is applied to an unsolved
+   goal ([advance] is used to figure if a side effect has modified the
+   goal) it terminates quickly. *)
+let rec advance sigma evk =
+  let evi = Evd.find sigma evk in
+  match evi.evar_body with
+  | Evar_empty -> Some evk
+  | Evar_defined v ->
+      if Option.default false (Store.get evi.evar_extra cleared) then
+        let (evk,_) = Term.destEvar v in
+        advance sigma evk
+      else
+        None
+
 (** The following functions return the set of undefined evars
     contained in the object, the defined evars being traversed.
     This is roughly a combination of the previous functions and
@@ -653,9 +708,8 @@ let undefined_evars_of_term evd t =
   evrec Evar.Set.empty t
 
 let undefined_evars_of_named_context evd nc =
-  let open Context.Named.Declaration in
   Context.Named.fold_outside
-    (fold (fun c s -> Evar.Set.union s (undefined_evars_of_term evd c)))
+    (NamedDecl.fold_constr (fun c s -> Evar.Set.union s (undefined_evars_of_term evd c)))
     nc
     ~init:Evar.Set.empty
 
diff --git a/engine/evarutil.mli b/engine/evarutil.mli
index ffff2c5dd..7fdc7aac7 100644
--- a/engine/evarutil.mli
+++ b/engine/evarutil.mli
@@ -11,7 +11,7 @@ open Term
 open Evd
 open Environ
 
-(** {5 This modules provides useful functions for unification modulo evars } *)
+(** This module provides useful higher-level functions for evar manipulation. *)
 
 (** {6 Metas} *)
 
@@ -110,6 +110,12 @@ val is_ground_env  :  evar_map -> env -> bool
     its (partial) definition. *)
 val gather_dependent_evars : evar_map -> evar list -> (Evar.Set.t option) Evar.Map.t
 
+(** [advance sigma g] returns [Some g'] if [g'] is undefined and is
+    the current avatar of [g] (for instance [g] was changed by [clear]
+    into [g']). It returns [None] if [g] has been (partially)
+    solved. *)
+val advance : evar_map -> evar -> evar option
+
 (** The following functions return the set of undefined evars
     contained in the object, the defined evars being traversed.
     This is roughly a combination of the previous functions and
@@ -199,8 +205,20 @@ val clear_hyps_in_evi : env -> evar_map ref -> named_context_val -> types ->
 val clear_hyps2_in_evi : env -> evar_map ref -> named_context_val -> types -> types ->
   Id.Set.t -> named_context_val * types * types
 
+type csubst
+
+val empty_csubst : csubst
+val csubst_subst : csubst -> Constr.t -> Constr.t
+
+type ext_named_context =
+  csubst * (Id.t * Constr.constr) list *
+  Id.Set.t * Context.Named.t
+
+val push_rel_decl_to_named_context :
+  Context.Rel.Declaration.t -> ext_named_context -> ext_named_context
+
 val push_rel_context_to_named_context : Environ.env -> types ->
-  named_context_val * types * constr list * constr list * (identifier*constr) list
+  named_context_val * types * constr list * csubst * (identifier*constr) list
 
 val generalize_evar_over_rels : evar_map -> existential -> types * constr list
 
diff --git a/engine/evd.ml b/engine/evd.ml
index b883db615..62d396395 100644
--- a/engine/evd.ml
+++ b/engine/evd.ml
@@ -7,17 +7,19 @@
 (************************************************************************)
 
 open Pp
-open Errors
+open CErrors
 open Util
 open Names
 open Nameops
 open Term
 open Vars
-open Termops
 open Environ
 open Globnames
 open Context.Named.Declaration
 
+module RelDecl = Context.Rel.Declaration
+module NamedDecl = Context.Named.Declaration
+
 (** Generic filters *)
 module Filter :
 sig
@@ -226,7 +228,7 @@ let evar_instance_array test_id info args =
     if i < len then
       let c = Array.unsafe_get args i in
       if test_id d c then instrec filter ctxt (succ i)
-      else (get_id d, c) :: instrec filter ctxt (succ i)
+      else (NamedDecl.get_id d, c) :: instrec filter ctxt (succ i)
     else instance_mismatch ()
   | _ -> instance_mismatch ()
   in
@@ -235,7 +237,7 @@ let evar_instance_array test_id info args =
      let map i d =
       if (i < len) then
         let c = Array.unsafe_get args i in
-        if test_id d c then None else Some (get_id d, c)
+        if test_id d c then None else Some (NamedDecl.get_id d, c)
       else instance_mismatch ()
     in
     List.map_filter_i map (evar_context info)
@@ -243,7 +245,7 @@ let evar_instance_array test_id info args =
     instrec filter (evar_context info) 0
 
 let make_evar_instance_array info args =
-  evar_instance_array (isVarId % get_id) info args
+  evar_instance_array (NamedDecl.get_id %> isVarId) info args
 
 let instantiate_evar_array info c args =
   let inst = make_evar_instance_array info args in
@@ -252,6 +254,7 @@ let instantiate_evar_array info c args =
   | _ -> replace_vars inst c
 
 type evar_universe_context = UState.t
+
 type 'a in_evar_universe_context = 'a * evar_universe_context
 
 let empty_evar_universe_context = UState.empty
@@ -283,7 +286,7 @@ let metavars_of c =
   let rec collrec acc c =
     match kind_of_term c with
       | Meta mv -> Int.Set.add mv acc
-      | _         -> fold_constr collrec acc c
+      | _         -> Term.fold_constr collrec acc c
   in
   collrec Int.Set.empty c
 
@@ -382,8 +385,7 @@ let add_name_newly_undefined naming evk evi (evtoid, idtoev as names) =
   | Misctypes.IntroAnonymous -> None
   | Misctypes.IntroIdentifier id ->
     if Idmap.mem id idtoev then
-    user_err_loc
-      (Loc.ghost,"",str "Already an existential evar of name " ++ pr_id id);
+    user_err  (str "Already an existential evar of name " ++ pr_id id);
     Some id
   | Misctypes.IntroFresh id ->
     let id = Namegen.next_ident_away_from id (fun id -> Idmap.mem id idtoev) in
@@ -640,6 +642,7 @@ let set_universe_context evd uctx' =
   { evd with universes = uctx' }
 
 let add_conv_pb ?(tail=false) pb d =
+  (** MS: we have duplicates here, why? *)
   if tail then {d with conv_pbs = d.conv_pbs @ [pb]}
   else {d with conv_pbs = pb::d.conv_pbs}
 
@@ -678,13 +681,16 @@ let restrict evk filter ?candidates evd =
     { evar_info with evar_filter = filter;
       evar_candidates = candidates;
       evar_extra = Store.empty } in
+  let last_mods = match evd.conv_pbs with
+  | [] ->  evd.last_mods
+  | _ -> Evar.Set.add evk evd.last_mods in
   let evar_names = EvNames.reassign_name_defined evk evk' evd.evar_names in
   let ctxt = Filter.filter_list filter (evar_context evar_info) in
-  let id_inst = Array.map_of_list (mkVar % get_id) ctxt in
+  let id_inst = Array.map_of_list (NamedDecl.get_id %> mkVar) ctxt in
   let body = mkEvar(evk',id_inst) in
   let (defn_evars, undf_evars) = define_aux evd.defn_evars evd.undf_evars evk body in
   { evd with undf_evars = EvMap.add evk' evar_info' undf_evars;
-    defn_evars; evar_names }, evk'
+    defn_evars; last_mods; evar_names }, evk'
 
 let downcast evk ccl evd =
   let evar_info = EvMap.find evk evd.undf_evars in
@@ -730,23 +736,22 @@ let evar_list c =
   let rec evrec acc c =
     match kind_of_term c with
     | Evar (evk, _ as ev) -> ev :: acc
-    | _ -> fold_constr evrec acc c in
+    | _ -> Term.fold_constr evrec acc c in
   evrec [] c
 
 let evars_of_term c =
   let rec evrec acc c =
     match kind_of_term c with
     | Evar (n, l) -> Evar.Set.add n (Array.fold_left evrec acc l)
-    | _ -> fold_constr evrec acc c
+    | _ -> Term.fold_constr evrec acc c
   in
   evrec Evar.Set.empty c
 
 let evars_of_named_context nc =
-  List.fold_right (fun decl s ->
-    Option.fold_left (fun s t ->
-      Evar.Set.union s (evars_of_term t))
-      (Evar.Set.union s (evars_of_term (get_type decl))) (get_value decl))
-    nc Evar.Set.empty
+  Context.Named.fold_outside
+    (NamedDecl.fold_constr (fun constr s -> Evar.Set.union s (evars_of_term constr)))
+    nc
+    ~init:Evar.Set.empty
 
 let evars_of_filtered_evar_info evi =
   Evar.Set.union (evars_of_term evi.evar_concl)
@@ -789,16 +794,16 @@ let merge_universe_subst evd subst =
 let with_context_set ?loc rigid d (a, ctx) =
   (merge_context_set ?loc rigid d ctx, a)
 
-let new_univ_level_variable ?loc ?name ?(predicative=true) rigid evd =
+let new_univ_level_variable ?loc ?name rigid evd =
   let uctx', u = UState.new_univ_variable ?loc rigid name evd.universes in
     ({evd with universes = uctx'}, u)
 
-let new_univ_variable ?loc ?name ?(predicative=true) rigid evd =
+let new_univ_variable ?loc ?name rigid evd =
   let uctx', u = UState.new_univ_variable ?loc rigid name evd.universes in
     ({evd with universes = uctx'}, Univ.Universe.make u)
 
-let new_sort_variable ?loc ?name ?(predicative=true) rigid d =
-  let (d', u) = new_univ_variable ?loc rigid ?name ~predicative d in
+let new_sort_variable ?loc ?name rigid d =
+  let (d', u) = new_univ_variable ?loc rigid ?name d in
     (d', Type u)
 
 let add_global_univ d u =
@@ -852,6 +857,13 @@ let is_eq_sort s1 s2 =
       if Univ.Universe.equal u1 u2 then None
       else Some (u1, u2)
 
+(* Precondition: l is not defined in the substitution *)
+let universe_rigidity evd l =
+  let uctx = evd.universes in
+  if Univ.LSet.mem l (Univ.ContextSet.levels (UState.context_set uctx)) then
+    UnivFlexible (Univ.LSet.mem l (UState.algebraics uctx))
+  else UnivRigid
+
 let normalize_universe evd =
   let vars = ref (UState.subst evd.universes) in
   let normalize = Universes.normalize_universe_opt_subst vars in
@@ -998,7 +1010,7 @@ let declare_principal_goal evk evd =
   | None -> { evd with
     future_goals = evk::evd.future_goals;
     principal_future_goal=Some evk; }
-  | Some _ -> Errors.error "Only one main subgoal per instantiation."
+  | Some _ -> CErrors.error "Only one main subgoal per instantiation."
 
 let future_goals evd = evd.future_goals
 
@@ -1257,6 +1269,14 @@ let pr_instance_status (sc,typ) =
   | TypeProcessed -> str " [type is checked]"
   end
 
+let protect f x =
+  try f x
+  with e -> str "EXCEPTION: " ++ str (Printexc.to_string e)
+
+let (f_print_constr, print_constr_hook) = Hook.make ()
+
+let print_constr a = protect (fun c -> Hook.get f_print_constr (Global.env ()) c) a
+
 let pr_meta_map mmap =
   let pr_name = function
       Name id -> str"[" ++ pr_id id ++ str"]"
@@ -1276,13 +1296,13 @@ let pr_meta_map mmap =
   prlist pr_meta_binding (metamap_to_list mmap)
 
 let pr_decl (decl,ok) =
-  let id = get_id decl in
-  match get_value decl with
-  | None -> if ok then pr_id id else (str "{" ++ pr_id id ++ str "}")
-  | Some c -> str (if ok then "(" else "{") ++ pr_id id ++ str ":=" ++
-      print_constr c ++ str (if ok then ")" else "}")
+  match decl with
+  | LocalAssum (id,_) -> if ok then pr_id id else (str "{" ++ pr_id id ++ str "}")
+  | LocalDef (id,c,_) -> str (if ok then "(" else "{") ++ pr_id id ++ str ":=" ++
+                           print_constr c ++ str (if ok then ")" else "}")
 
 let pr_evar_source = function
+  | Evar_kinds.NamedHole id -> pr_id id
   | Evar_kinds.QuestionMark _ -> str "underscore"
   | Evar_kinds.CasesType false -> str "pattern-matching return predicate"
   | Evar_kinds.CasesType true ->
@@ -1391,12 +1411,11 @@ let pr_evar_universe_context ctx =
        h 0 (Universes.pr_universe_opt_subst (UState.subst ctx)) ++ fnl())
 
 let print_env_short env =
-  let pr_body n = function
-  | None -> pr_name n
-  | Some b -> str "(" ++ pr_name n ++ str " := " ++ print_constr b ++ str ")" in
-  let pr_named_decl decl = pr_body (Name (get_id decl)) (get_value decl) in
-  let pr_rel_decl decl = let open Context.Rel.Declaration in
-                         pr_body (get_name decl) (get_value decl) in
+  let pr_rel_decl = function
+    | RelDecl.LocalAssum (n,_) -> pr_name n
+    | RelDecl.LocalDef (n,b,_) -> str "(" ++ pr_name n ++ str " := " ++ print_constr b ++ str ")"
+  in
+  let pr_named_decl = NamedDecl.to_rel_decl %> pr_rel_decl in
   let nc = List.rev (named_context env) in
   let rc = List.rev (rel_context env) in
     str "[" ++ pr_sequence pr_named_decl nc ++ str "]" ++ spc () ++
@@ -1404,12 +1423,22 @@ let print_env_short env =
 
 let pr_evar_constraints pbs =
   let pr_evconstr (pbty, env, t1, t2) =
+    let env =
+      (** We currently allow evar instances to refer to anonymous de
+          Bruijn indices, so we protect the error printing code in this
+          case by giving names to every de Bruijn variable in the
+          rel_context of the conversion problem. MS: we should rather
+          stop depending on anonymous variables, they can be used to
+          indicate independency. Also, this depends on a strategy for
+          naming/renaming. *)
+      Namegen.make_all_name_different env
+    in
     print_env_short env ++ spc () ++ str "|-" ++ spc () ++
-      print_constr_env env t1 ++ spc () ++
+      Hook.get f_print_constr env t1 ++ spc () ++
       str (match pbty with
             | Reduction.CONV -> "=="
             | Reduction.CUMUL -> "<=") ++
-      spc () ++ print_constr_env env t2
+      spc () ++ Hook.get f_print_constr env t2
   in
   prlist_with_sep fnl pr_evconstr pbs
 
diff --git a/engine/evd.mli b/engine/evd.mli
index 3ae6e586c..993ed300b 100644
--- a/engine/evd.mli
+++ b/engine/evd.mli
@@ -12,7 +12,10 @@ open Names
 open Term
 open Environ
 
-(** {5 Existential variables and unification states}
+(** This file defines the pervasive unification state used everywhere in Coq
+    tactic engine. It is very low-level and most of the functions exported here
+    are irrelevant to the standard API user. Consider using {!Evarutil},
+    {!Sigma} or {!Proofview} instead.
 
     A unification state (of type [evar_map]) is primarily a finite mapping
     from existential variables to records containing the type of the evar
@@ -23,6 +26,8 @@ open Environ
     It also contains conversion constraints, debugging information and
     information about meta variables. *)
 
+(** {5 Existential variables and unification states} *)
+
 (** {6 Evars} *)
 
 type evar = existential_key
@@ -93,11 +98,12 @@ type evar_info = {
   (** Optional content of the evar. *)
   evar_filter : Filter.t;
   (** Boolean mask over {!evar_hyps}. Should have the same length.
-      TODO: document me more. *)
+      When filtered out, the corresponding variable is not allowed to occur
+      in the solution *)
   evar_source : Evar_kinds.t located;
   (** Information about the evar. *)
   evar_candidates : constr list option;
-  (** TODO: document this *)
+  (** List of possible solutions when known that it is a finite list *)
   evar_extra : Store.t
   (** Extra store, used for clever hacks. *)
 }
@@ -343,7 +349,6 @@ val on_sig : 'a sigma -> (evar_map -> evar_map * 'b) -> 'a sigma * 'b
 module MonadR : Monad.S with type +'a t = evar_map -> evar_map * 'a
 module Monad  : Monad.S with type +'a t = evar_map -> 'a * evar_map
 
-
 (** {5 Meta machinery}
 
     These functions are almost deprecated. They were used before the
@@ -462,7 +467,17 @@ val retract_coercible_metas : evar_map -> metabinding list * evar_map
 (*********************************************************
    Sort/universe variables *)
 
-(** Rigid or flexible universe variables *)
+(** Rigid or flexible universe variables.
+
+   [UnivRigid] variables are user-provided or come from an explicit
+   [Type] in the source, we do not minimize them or unify them eagerly.
+
+   [UnivFlexible alg] variables are fresh universe variables of
+   polymorphic constants or generated during refinement, sometimes in
+   algebraic position (i.e. not appearing in the term at the moment of
+   creation). They are the candidates for minimization (if alg, to an
+   algebraic universe) and unified eagerly in the first-order
+   unification heurstic.  *)
 
 type rigid = UState.rigid =
   | UnivRigid
@@ -504,11 +519,13 @@ val normalize_evar_universe_context_variables : evar_universe_context ->
 val normalize_evar_universe_context : evar_universe_context -> 
   evar_universe_context
 
-val new_univ_level_variable : ?loc:Loc.t -> ?name:string -> ?predicative:bool -> rigid -> evar_map -> evar_map * Univ.universe_level
-val new_univ_variable : ?loc:Loc.t -> ?name:string -> ?predicative:bool -> rigid -> evar_map -> evar_map * Univ.universe
-val new_sort_variable : ?loc:Loc.t -> ?name:string -> ?predicative:bool -> rigid -> evar_map -> evar_map * sorts
+val new_univ_level_variable : ?loc:Loc.t -> ?name:string -> rigid -> evar_map -> evar_map * Univ.universe_level
+val new_univ_variable : ?loc:Loc.t -> ?name:string -> rigid -> evar_map -> evar_map * Univ.universe
+val new_sort_variable : ?loc:Loc.t -> ?name:string -> rigid -> evar_map -> evar_map * sorts
+
 val add_global_univ : evar_map -> Univ.Level.t -> evar_map
-											   
+
+val universe_rigidity : evar_map -> Univ.Level.t -> rigid
 val make_flexible_variable : evar_map -> bool -> Univ.universe_level -> evar_map
 val is_sort_variable : evar_map -> sorts -> Univ.universe_level option 
 (** [is_sort_variable evm s] returns [Some u] or [None] if [s] is 
@@ -564,8 +581,8 @@ val fresh_constant_instance : ?loc:Loc.t -> env -> evar_map -> constant -> evar_
 val fresh_inductive_instance : ?loc:Loc.t -> env -> evar_map -> inductive -> evar_map * pinductive
 val fresh_constructor_instance : ?loc:Loc.t -> env -> evar_map -> constructor -> evar_map * pconstructor
 
-val fresh_global : ?loc:Loc.t -> ?rigid:rigid -> ?names:Univ.Instance.t -> env -> evar_map -> 
-  Globnames.global_reference -> evar_map * constr
+val fresh_global : ?loc:Loc.t -> ?rigid:rigid -> ?names:Univ.Instance.t -> env ->
+  evar_map -> Globnames.global_reference -> evar_map * constr
 
 (********************************************************************
   Conversion w.r.t. an evar map, not unifying universes. See 
@@ -601,6 +618,7 @@ val pr_evar_suggested_name : existential_key -> evar_map -> Id.t
 
 (** {5 Debug pretty-printers} *)
 
+val print_constr_hook : (Environ.env -> constr -> Pp.std_ppcmds) Hook.t
 val pr_evar_info : evar_info -> Pp.std_ppcmds
 val pr_evar_constraints : evar_constraint list -> Pp.std_ppcmds
 val pr_evar_map : ?with_univs:bool -> int option -> evar_map -> Pp.std_ppcmds
diff --git a/engine/ftactic.ml b/engine/ftactic.ml
index 588709873..aeaaea7e4 100644
--- a/engine/ftactic.ml
+++ b/engine/ftactic.ml
@@ -29,13 +29,28 @@ let bind (type a) (type b) (m : a t) (f : a -> b t) : b t = m >>= function
   | Uniform x ->
     (** We dispatch the uniform result on each goal under focus, as we know
         that the [m] argument was actually dependent. *)
-    Proofview.Goal.goals >>= fun l ->
-    let ans = List.map (fun _ -> x) l in
+    Proofview.Goal.goals >>= fun goals ->
+    let ans = List.map (fun g -> (g,x)) goals in
     Proofview.tclUNIT ans
-  | Depends l -> Proofview.tclUNIT l
+  | Depends l ->
+    Proofview.Goal.goals >>= fun goals ->
+    Proofview.tclUNIT (List.combine goals l)
+  in
+  (* After the tactic has run, some goals which were previously
+     produced may have been solved by side effects. The values
+     attached to such goals must be discarded, otherwise the list of
+     result would not have the same length as the list of focused
+     goals, which is an invariant of the [Ftactic] module. It is the
+     reason why a goal is attached to each result above. *)
+  let filter (g,x) =
+    g >>= fun g ->
+    Proofview.Goal.unsolved g >>= function
+    | true -> Proofview.tclUNIT (Some x)
+    | false -> Proofview.tclUNIT None
   in
   Proofview.tclDISPATCHL (List.map f l) >>= fun l ->
-  Proofview.tclUNIT (Depends (List.concat l))
+  Proofview.Monad.List.map_filter filter (List.concat l) >>= fun filtered ->
+  Proofview.tclUNIT (Depends filtered)
 
 let goals = Proofview.Goal.goals >>= fun l -> Proofview.tclUNIT (Depends l)
 let set_sigma r =
diff --git a/engine/ftactic.mli b/engine/ftactic.mli
index 19041f169..5db373199 100644
--- a/engine/ftactic.mli
+++ b/engine/ftactic.mli
@@ -8,7 +8,9 @@
 
 open Proofview.Notations
 
-(** Potentially focussing tactics *)
+(** This module defines potentially focussing tactics. They are used by Ltac to
+    emulate the historical behaviour of always-focussed tactics while still
+    allowing to remain global when the goal is not needed. *)
 
 type +'a focus
 
diff --git a/engine/geninterp.mli b/engine/geninterp.mli
index 42e1e3784..b70671a2d 100644
--- a/engine/geninterp.mli
+++ b/engine/geninterp.mli
@@ -6,7 +6,8 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(** Interpretation functions for generic arguments. *)
+(** Interpretation functions for generic arguments and interpreted Ltac
+    values. *)
 
 open Names
 open Genarg
diff --git a/engine/logic_monad.ml b/engine/logic_monad.ml
index 64be07b9c..6e821ea5a 100644
--- a/engine/logic_monad.ml
+++ b/engine/logic_monad.ml
@@ -33,11 +33,11 @@ exception Timeout
     interrupts). *)
 exception TacticFailure of exn
 
-let _ = Errors.register_handler begin function
-  | Timeout -> Errors.errorlabstrm "Some timeout function" (Pp.str"Timeout!")
-  | Exception e -> Errors.print e
-  | TacticFailure e -> Errors.print e
-  | _ -> Pervasives.raise Errors.Unhandled
+let _ = CErrors.register_handler begin function
+  | Timeout -> CErrors.user_err ~hdr:"Some timeout function" (Pp.str"Timeout!")
+  | Exception e -> CErrors.print e
+  | TacticFailure e -> CErrors.print e
+  | _ -> Pervasives.raise CErrors.Unhandled
 end
 
 (** {6 Non-logical layer} *)
@@ -86,11 +86,11 @@ struct
   let catch = fun s h -> ();
     fun () -> try s ()
       with Exception e as src ->
-        let (src, info) = Errors.push src in
+        let (src, info) = CErrors.push src in
         h (e, info) ()
 
   let read_line = fun () -> try Pervasives.read_line () with e ->
-    let (e, info) = Errors.push e in raise ~info e ()
+    let (e, info) = CErrors.push e in raise ~info e ()
 
   let print_char = fun c -> (); fun () -> print_char c
 
@@ -99,8 +99,8 @@ struct
 
   let make f = (); fun () ->
     try f ()
-    with e when Errors.noncritical e ->
-      let (e, info) = Errors.push e in
+    with e when CErrors.noncritical e ->
+      let (e, info) = CErrors.push e in
       Util.iraise (Exception e, info)
 
   (** Use the current logger. The buffer is also flushed. *)
@@ -112,7 +112,7 @@ struct
 
   let run = fun x ->
     try x () with Exception e as src ->
-      let (src, info) = Errors.push src in
+      let (src, info) = CErrors.push src in
       Util.iraise (e, info)
 end
 
diff --git a/engine/logic_monad.mli b/engine/logic_monad.mli
index c5160443b..dd122cca0 100644
--- a/engine/logic_monad.mli
+++ b/engine/logic_monad.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(** This file defines the low-level monadic operations used by the
+(** This file implements the low-level monadic operations used by the
     tactic monad. The monad is divided into two layers: a non-logical
     layer which consists in operations which will not (or cannot) be
     backtracked in case of failure (input/output or persistent state)
diff --git a/engine/namegen.ml b/engine/namegen.ml
index 6b2b58531..e56ec2877 100644
--- a/engine/namegen.ml
+++ b/engine/namegen.ml
@@ -21,9 +21,10 @@ open Nameops
 open Libnames
 open Globnames
 open Environ
-open Termops
 open Context.Rel.Declaration
 
+module RelDecl = Context.Rel.Declaration
+
 (**********************************************************************)
 (* Conventional names *)
 
@@ -76,6 +77,10 @@ let is_constructor id =
   with Not_found ->
     false
 
+let is_section_variable id =
+  try let _ = Global.lookup_named id in true
+  with Not_found -> false
+
 (**********************************************************************)
 (* Generating "intuitive" names from its type *)
 
@@ -114,9 +119,9 @@ let hdchar env c =
     | Rel n ->
 	(if n<=k then "p" (* the initial term is flexible product/function *)
 	 else
-	   try match Environ.lookup_rel (n-k) env |> to_tuple with
-	     | (Name id,_,_)   -> lowercase_first_char id
-	     | (Anonymous,_,t) -> hdrec 0 (lift (n-k) t)
+	   try match Environ.lookup_rel (n-k) env with
+	     | LocalAssum (Name id,_)   | LocalDef (Name id,_,_) -> lowercase_first_char id
+	     | LocalAssum (Anonymous,t) | LocalDef (Anonymous,_,t) -> hdrec 0 (lift (n-k) t)
 	   with Not_found -> "y")
     | Fix ((_,i),(lna,_,_)) | CoFix (i,(lna,_,_)) ->
 	let id = match lna.(i) with Name id -> id | _ -> assert false in
@@ -168,7 +173,7 @@ let it_mkLambda_or_LetIn_name env b hyps =
 (* Looks for next "good" name by lifting subscript *)
 
 let next_ident_away_from id bad =
-  let rec name_rec id = if bad id then name_rec (lift_subscript id) else id in
+  let rec name_rec id = if bad id then name_rec (increment_subscript id) else id in
   name_rec id
 
 (* Restart subscript from x0 if name starts with xN, or x00 if name
@@ -180,32 +185,44 @@ let restart_subscript id =
      *** make_ident id (Some 0) *** but compatibility would be lost... *)
     forget_subscript id
 
-let rec to_avoid id = function
-| [] -> false
-| id' :: avoid -> Id.equal id id' || to_avoid id avoid
-
-let occur_rel p env id =
-  try
-    let name = lookup_name_of_rel p env in
-    begin match name with
-    | Name id' -> Id.equal id' id
-    | Anonymous -> false
-    end
-  with Not_found -> false (* Unbound indice : may happen in debug *)
-
-let visibly_occur_id id (nenv,c) =
-  let rec occur n c = match kind_of_term c with
-    | Const _ | Ind _ | Construct _ | Var _
-      when
-        let short = shortest_qualid_of_global Id.Set.empty (global_of_constr c) in
-        qualid_eq short (qualid_of_ident id) ->
-      raise Occur
-    | Rel p when p>n && occur_rel (p-n) nenv id -> raise Occur
-    | _ -> iter_constr_with_binders succ occur n c
+let visible_ids (nenv, c) =
+  let accu = ref (Refset_env.empty, Int.Set.empty, Id.Set.empty) in
+  let rec visible_ids n c = match kind_of_term c with
+  | Const _ | Ind _ | Construct _ | Var _ ->
+    let (gseen, vseen, ids) = !accu in
+    let g = global_of_constr c in
+    if not (Refset_env.mem g gseen) then
+      begin
+      try
+      let gseen = Refset_env.add g gseen in
+      let short = shortest_qualid_of_global Id.Set.empty g in
+      let dir, id = repr_qualid short in
+      let ids = if DirPath.is_empty dir then Id.Set.add id ids else ids in
+      accu := (gseen, vseen, ids)
+      with Not_found when !Flags.in_debugger || !Flags.in_toplevel -> ()
+      end
+  | Rel p ->
+    let (gseen, vseen, ids) = !accu in
+    if p > n && not (Int.Set.mem p vseen) then
+      let vseen = Int.Set.add p vseen in
+      let name =
+        try Some (List.nth nenv (p - n - 1))
+        with Invalid_argument _ | Failure _ ->
+          (* Unbound index: may happen in debug and actually also
+             while computing temporary implicit arguments of an
+             inductive type *)
+          None
+      in
+      let ids = match name with
+      | Some (Name id) -> Id.Set.add id ids
+      | _ -> ids
+      in
+      accu := (gseen, vseen, ids)
+  | _ -> Constr.iter_with_binders succ visible_ids n c
   in
-  try occur 1 c; false
-  with Occur -> true
-    | Not_found -> false (* Happens when a global is not in the env *)
+  let () = visible_ids 1 c in
+  let (_, _, ids) = !accu in
+  ids
 
 (* Now, there are different renaming strategies... *)
 
@@ -213,8 +230,9 @@ let visibly_occur_id id (nenv,c) =
 
 let next_name_away_in_cases_pattern env_t na avoid =
   let id = match na with Name id -> id | Anonymous -> default_dependent_ident in
-  let bad id = to_avoid id avoid || is_constructor id
-                                 || visibly_occur_id id env_t in
+  let visible = visible_ids env_t in
+  let bad id = Id.List.mem id avoid || is_constructor id
+                                    || Id.Set.mem id visible in
   next_ident_away_from id bad
 
 (* 2- Looks for a fresh name for introduction in goal *)
@@ -227,8 +245,8 @@ let next_name_away_in_cases_pattern env_t na avoid =
      name is taken by finding a free subscript starting from 0 *)
 
 let next_ident_away_in_goal id avoid =
-  let id = if to_avoid id avoid then restart_subscript id else id in
-  let bad id = to_avoid id avoid || (is_global id && not (is_section_variable id)) in
+  let id = if Id.List.mem id avoid then restart_subscript id else id in
+  let bad id = Id.List.mem id avoid || (is_global id && not (is_section_variable id)) in
   next_ident_away_from id bad
 
 let next_name_away_in_goal na avoid =
@@ -245,16 +263,16 @@ let next_name_away_in_goal na avoid =
    beyond the current subscript *)
 
 let next_global_ident_away id avoid =
-  let id = if to_avoid id avoid then restart_subscript id else id in
-  let bad id = to_avoid id avoid || is_global id in
+  let id = if Id.List.mem id avoid then restart_subscript id else id in
+  let bad id = Id.List.mem id avoid || is_global id in
   next_ident_away_from id bad
 
 (* 4- Looks for next fresh name outside a list; if name already used,
    looks for same name with lower available subscript *)
 
 let next_ident_away id avoid =
-  if to_avoid id avoid then
-    next_ident_away_from (restart_subscript id) (fun id -> to_avoid id avoid)
+  if Id.List.mem id avoid then
+    next_ident_away_from (restart_subscript id) (fun id -> Id.List.mem id avoid)
   else id
 
 let next_name_away_with_default default na avoid =
@@ -275,15 +293,18 @@ let next_name_away_with_default_using_types default na avoid t =
 let next_name_away = next_name_away_with_default default_non_dependent_string
 
 let make_all_name_different env =
-  let avoid = ref (ids_of_named_context (named_context env)) in
-  process_rel_context
+  (** FIXME: this is inefficient, but only used in printing *)
+  let avoid = ref (Id.Set.elements (Context.Named.to_vars (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
+  Context.Rel.fold_outside
     (fun decl newenv ->
-       let (na,_,t) = to_tuple decl in
-       let na = named_hd newenv t na in
+       let na = named_hd newenv (RelDecl.get_type decl) (RelDecl.get_name decl) in
        let id = next_name_away na !avoid in
        avoid := id::!avoid;
-       push_rel (set_name (Name id) decl) newenv)
-    env
+       push_rel (RelDecl.set_name (Name id) decl) newenv)
+    rels ~init:env0
 
 (* 5- Looks for next fresh name outside a list; avoids also to use names that
    would clash with short name of global references; if name is already used,
@@ -291,7 +312,8 @@ let make_all_name_different env =
    subscript *)
 
 let next_ident_away_for_default_printing env_t id avoid =
-  let bad id = to_avoid id avoid || visibly_occur_id id env_t in
+  let visible = visible_ids env_t in
+  let bad id = Id.List.mem id avoid || Id.Set.mem id visible in
   next_ident_away_from id bad
 
 let next_name_away_for_default_printing env_t na avoid =
@@ -362,12 +384,12 @@ let rename_bound_vars_as_displayed avoid env c =
 	let na',avoid' =
           compute_displayed_name_in
             (RenamingElsewhereFor (env,c2)) avoid na c2 in
-	mkProd (na', c1, rename avoid' (add_name na' env) c2)
+	mkProd (na', c1, rename avoid' (na' :: env) c2)
     | LetIn (na,c1,t,c2) ->
 	let na',avoid' =
           compute_displayed_let_name_in
             (RenamingElsewhereFor (env,c2)) avoid na c2 in
-	mkLetIn (na',c1,t, rename avoid' (add_name na' env) c2)
+	mkLetIn (na',c1,t, rename avoid' (na' :: env) c2)
     | Cast (c,k,t) -> mkCast (rename avoid env c, k,t)
     | _ -> c
   in
diff --git a/engine/namegen.mli b/engine/namegen.mli
index a2923fee9..33ce9a34d 100644
--- a/engine/namegen.mli
+++ b/engine/namegen.mli
@@ -6,6 +6,8 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
+(** This file features facilities to generate fresh names. *)
+
 open Names
 open Term
 open Environ
@@ -52,7 +54,22 @@ val it_mkLambda_or_LetIn_name : env -> constr -> Context.Rel.t -> constr
 (** Avoid clashing with a name satisfying some predicate *)
 val next_ident_away_from : Id.t -> (Id.t -> bool) -> Id.t
 
-(** Avoid clashing with a name of the given list *)
+(** [next_ident_away original_id unwanted_ids] returns a new identifier as close as possible
+    to the [original_id] while avoiding all [unwanted_ids].
+
+    In particular:
+    {ul {- if [original_id] does not appear in the list of [unwanted_ids], then [original_id] is returned.}
+        {- if [original_id] appears in the list of [unwanted_ids],
+           then this function returns a new id that:
+           {ul {- has the same {i root} as the [original_id],}
+               {- does not occur in the list of [unwanted_ids],}
+               {- has the smallest possible {i subscript}.}}}}
+
+    where by {i subscript} of some identifier we mean last part of it that is composed
+    only from (decimal) digits and by {i root} of some identifier we mean
+    the whole identifier except for the {i subscript}.
+
+    E.g. if we take [foo42], then [42] is the {i subscript}, and [foo] is the root. *)
 val next_ident_away : Id.t -> Id.t list -> Id.t
 
 (** Avoid clashing with a name already used in current module *)
@@ -62,9 +79,6 @@ val next_ident_away_in_goal : Id.t -> Id.t list -> Id.t
    but tolerate overwriting section variables, as in goals *)
 val next_global_ident_away : Id.t -> Id.t list -> Id.t
 
-(** Avoid clashing with a constructor name already used in current module *)
-val next_name_away_in_cases_pattern : (Termops.names_context * constr) -> Name.t -> Id.t list -> Id.t
-
 (** Default is [default_non_dependent_ident] *)
 val next_name_away  : Name.t -> Id.t list -> Id.t
 
diff --git a/engine/proofview.ml b/engine/proofview.ml
index bcdd4da11..721389af4 100644
--- a/engine/proofview.ml
+++ b/engine/proofview.ml
@@ -22,6 +22,8 @@ open Context.Named.Declaration
 (** Main state of tactics *)
 type proofview = Proofview_monad.proofview
 
+(* The first items in pairs below are proofs (under construction).
+   The second items in the pairs below are statements that are being proved. *)
 type entry = (Term.constr * Term.types) list
 
 (** Returns a stylised view of a proofview for use by, for instance,
@@ -152,33 +154,9 @@ let focus i j sp =
   let (new_comb, context) = focus_sublist i j sp.comb in
   ( { sp with comb = new_comb } , context )
 
-
-(** [advance sigma g] returns [Some g'] if [g'] is undefined and is
-    the current avatar of [g] (for instance [g] was changed by [clear]
-    into [g']). It returns [None] if [g] has been (partially)
-    solved. *)
-(* spiwack: [advance] is probably performance critical, and the good
-   behaviour of its definition may depend sensitively to the actual
-   definition of [Evd.find]. Currently, [Evd.find] starts looking for
-   a value in the heap of undefined variable, which is small. Hence in
-   the most common case, where [advance] is applied to an unsolved
-   goal ([advance] is used to figure if a side effect has modified the
-   goal) it terminates quickly. *)
-let rec advance sigma g =
-  let open Evd in
-  let evi = Evd.find sigma g in
-  match evi.evar_body with
-  | Evar_empty -> Some g
-  | Evar_defined v ->
-      if Option.default false (Store.get evi.evar_extra Evarutil.cleared) then
-        let (e,_) = Term.destEvar v in
-        advance sigma e
-      else
-        None
-
 (** [undefined defs l] is the list of goals in [l] which are still
     unsolved (after advancing cleared goals). *)
-let undefined defs l = CList.map_filter (advance defs) l
+let undefined defs l = CList.map_filter (Evarutil.advance defs) l
 
 (** Unfocuses a proofview with respect to a context. *)
 let unfocus c sp =
@@ -309,9 +287,9 @@ let tclIFCATCH a s f =
 let tclONCE = Proof.once
 
 exception MoreThanOneSuccess
-let _ = Errors.register_handler begin function
-  | MoreThanOneSuccess -> Errors.error "This tactic has more than one success."
-  | _ -> raise Errors.Unhandled
+let _ = CErrors.register_handler begin function
+  | MoreThanOneSuccess -> CErrors.error "This tactic has more than one success."
+  | _ -> raise CErrors.Unhandled
 end
 
 (** [tclEXACTLY_ONCE e t] succeeds as [t] if [t] has exactly one
@@ -362,12 +340,13 @@ let set_nosuchgoals_hook f = nosuchgoals_hook := f
 
 
 (* This uses the hook above *)
-let _ = Errors.register_handler begin function
+let _ = CErrors.register_handler begin function
   | NoSuchGoals n ->
     let suffix = !nosuchgoals_hook n in
-    Errors.errorlabstrm ""
-      (str "No such " ++ str (String.plural n "goal") ++ str "." ++ suffix)
-  | _ -> raise Errors.Unhandled
+    CErrors.user_err 
+      (str "No such " ++ str (String.plural n "goal") ++ str "." ++
+       pr_non_empty_arg (fun x -> x) suffix)
+      | _ -> raise CErrors.Unhandled
 end
 
 (** [tclFOCUS_gen nosuchgoal i j t] applies [t] in a context where
@@ -388,6 +367,36 @@ let tclFOCUS_gen nosuchgoal i j t =
 let tclFOCUS i j t = tclFOCUS_gen (tclZERO (NoSuchGoals (j+1-i))) i j t
 let tclTRYFOCUS i j t = tclFOCUS_gen (tclUNIT ()) i j t
 
+let tclFOCUSLIST l t =
+  let open Proof in
+  Comb.get >>= fun comb ->
+    let n = CList.length comb in
+    (* First, remove empty intervals, and bound the intervals to the number
+       of goals. *)
+    let sanitize (i, j) =
+      if i > j then None
+      else if i > n then None
+      else if j < 1 then None
+      else Some ((max i 1), (min j n))
+    in
+    let l = CList.map_filter sanitize l in
+    match l with
+      | [] -> tclZERO (NoSuchGoals 0)
+      | (mi, _) :: _ ->
+          (* Get the left-most goal to focus. This goal won't move, and we
+             will then place all the other goals to focus to the right. *)
+          let mi = CList.fold_left (fun m (i, _) -> min m i) mi l in
+          (* [CList.goto] returns a zipper, so that
+             [(rev left) @ sub_right = comb]. *)
+          let left, sub_right = CList.goto (mi-1) comb in
+          let p x _ = CList.exists (fun (i, j) -> i <= x + mi && x + mi <= j) l in
+          let sub, right = CList.partitioni p sub_right in
+          let mj = mi - 1 + CList.length sub in
+            Comb.set (CList.rev_append left (sub @ right)) >>
+            tclFOCUS mi mj t
+
+
+
 (** Like {!tclFOCUS} but selects a single goal by name. *)
 let tclFOCUSID id t =
   let open Proof in
@@ -413,15 +422,15 @@ let tclFOCUSID id t =
 (** {7 Dispatching on goals} *)
 
 exception SizeMismatch of int*int
-let _ = Errors.register_handler begin function
-  | SizeMismatch (i,_) ->
+let _ = CErrors.register_handler begin function
+  | SizeMismatch (i,j) ->
       let open Pp in
       let errmsg =
         str"Incorrect number of goals" ++ spc() ++
-        str"(expected "++int i++str(String.plural i " tactic") ++ str")."
+        str"(expected "++int i++str(String.plural i " tactic") ++ str", was given "++ int j++str")."
       in
-      Errors.errorlabstrm "" errmsg
-  | _ -> raise Errors.Unhandled
+      CErrors.user_err  errmsg
+  | _ -> raise CErrors.Unhandled
 end
 
 (** A variant of [Monad.List.iter] where we iter over the focused list
@@ -434,7 +443,7 @@ let iter_goal i =
   Comb.get >>= fun initial ->
   Proof.List.fold_left begin fun (subgoals as cur) goal ->
     Solution.get >>= fun step ->
-    match advance step goal with
+    match Evarutil.advance step goal with
     | None -> return cur
     | Some goal ->
         Comb.set [goal] >>
@@ -444,6 +453,25 @@ let iter_goal i =
   Solution.get >>= fun evd ->
   Comb.set CList.(undefined evd (flatten (rev subgoals)))
 
+(** List iter but allocates a list of results *)
+let map_goal i =
+  let rev = List.rev in (* hem... Proof masks List... *)
+  let open Proof in
+  Comb.get >>= fun initial ->
+  Proof.List.fold_left begin fun (acc, subgoals as cur) goal ->
+    Solution.get >>= fun step ->
+    match Evarutil.advance step goal with
+    | None -> return cur
+    | Some goal ->
+        Comb.set [goal] >>
+        i goal >>= fun res ->
+        Proof.map (fun comb -> comb :: subgoals) Comb.get >>= fun x ->
+        return (res :: acc, x)
+  end ([],[]) initial >>= fun (results_rev, subgoals) ->
+  Solution.get >>= fun evd ->
+  Comb.set CList.(undefined evd (flatten (rev subgoals))) >>
+  return (rev results_rev)
+
 (** A variant of [Monad.List.fold_left2] where the first list is the
     list of focused goals. The argument tactic is executed in a focus
     comprising only of the current goal, a goal which has been solved
@@ -458,7 +486,7 @@ let fold_left2_goal i s l =
   in 
   Proof.List.fold_left2 err begin fun ((r,subgoals) as cur) goal a ->
     Solution.get >>= fun step ->
-    match advance step goal with
+    match Evarutil.advance step goal with
     | None -> return cur
     | Some goal ->
         Comb.set [goal] >>
@@ -502,7 +530,7 @@ let tclDISPATCHGEN0 join tacs =
         let open Proof in
         Pv.get >>= function
         | { comb=[goal] ; solution } ->
-            begin match advance solution goal with
+            begin match Evarutil.advance solution goal with
             | None -> tclUNIT (join [])
             | Some _ -> Proof.map (fun res -> join [res]) tac
             end
@@ -576,7 +604,15 @@ let tclINDEPENDENT tac =
       let tac = InfoL.tag (Info.DBranch) tac in
       InfoL.tag (Info.Dispatch) (iter_goal (fun _ -> tac))
 
-
+let tclINDEPENDENTL tac =
+  let open Proof in
+  Pv.get >>= fun initial ->
+  match initial.comb with
+  | [] -> tclUNIT []
+  | [_] -> tac >>= fun x -> return [x]
+  | _ ->
+      let tac = InfoL.tag (Info.DBranch) tac in
+      InfoL.tag (Info.Dispatch) (map_goal (fun _ -> tac))
 
 (** {7 Goal manipulation} *)
 
@@ -588,6 +624,13 @@ let shelve =
   InfoL.leaf (Info.Tactic (fun () -> Pp.str"shelve")) >>
   Shelf.modify (fun gls -> gls @ initial)
 
+let shelve_goals l =
+  let open Proof in
+  Comb.get >>= fun initial ->
+  let comb = CList.filter (fun g -> not (CList.mem g l)) initial in
+  Comb.set comb >>
+  InfoL.leaf (Info.Tactic (fun () -> Pp.str"shelve_goals")) >>
+  Shelf.modify (fun gls -> gls @ l)
 
 (** [contained_in_info e evi] checks whether the evar [e] appears in
     the hypotheses, the conclusion or the body of the evar_info
@@ -647,6 +690,21 @@ let unshelve l p =
   let l = undefined p.solution l in
   { p with comb = p.comb@l }
 
+let mark_in_evm ~goal evd content =
+  let info = Evd.find evd content in
+  let info =
+    if goal then
+      { info with Evd.evar_source = match info.Evd.evar_source with
+            | _, (Evar_kinds.VarInstance _ | Evar_kinds.GoalEvar) as x -> x
+            | loc,_ -> loc,Evar_kinds.GoalEvar }
+    else info
+  in
+  let info = match Evd.Store.get info.Evd.evar_extra typeclass_resolvable with
+  | None -> { info with Evd.evar_extra = Evd.Store.set info.Evd.evar_extra typeclass_resolvable () }
+  | Some () -> info
+  in
+  Evd.add evd content info
+
 let with_shelf tac =
   let open Proof in
   Pv.get >>= fun pv ->
@@ -659,8 +717,11 @@ let with_shelf tac =
   let fgoals = Evd.future_goals solution in
   let pgoal = Evd.principal_future_goal solution in
   let sigma = Evd.restore_future_goals sigma fgoals pgoal in
-  Pv.set { npv with shelf; solution = sigma } >>
-  tclUNIT (CList.rev_append gls' gls, ans)
+  (* Ensure we mark and return only unsolved goals *)
+  let gls' = undefined sigma (CList.rev_append gls' gls) in
+  let sigma = CList.fold_left (mark_in_evm ~goal:false) sigma gls' in
+  let npv = { npv with shelf; solution = sigma } in
+  Pv.set npv >> tclUNIT (gls', ans)
 
 (** [goodmod p m] computes the representative of [p] modulo [m] in the
     interval [[0,m-1]].*)
@@ -807,12 +868,12 @@ let tclPROGRESS t =
   if not test then
     tclUNIT res
   else
-    tclZERO (Errors.UserError ("Proofview.tclPROGRESS" , Pp.str"Failed to progress."))
+    tclZERO (CErrors.UserError (Some "Proofview.tclPROGRESS" , Pp.str"Failed to progress."))
 
 exception Timeout
-let _ = Errors.register_handler begin function
-  | Timeout -> Errors.errorlabstrm "Proofview.tclTIMEOUT" (Pp.str"Tactic timeout!")
-  | _ -> Pervasives.raise Errors.Unhandled
+let _ = CErrors.register_handler begin function
+  | Timeout -> CErrors.user_err ~hdr:"Proofview.tclTIMEOUT" (Pp.str"Tactic timeout!")
+  | _ -> Pervasives.raise CErrors.Unhandled
 end
 
 let tclTIMEOUT n t =
@@ -891,6 +952,8 @@ module Unsafe = struct
       { step with comb = step.comb @ gls }
     end
 
+  let tclSETENV = Env.set
+
   let tclGETGOALS = Comb.get
 
   let tclSETGOALS = Comb.set
@@ -905,19 +968,12 @@ module Unsafe = struct
     { p with solution = Evd.reset_future_goals p.solution }
 
   let mark_as_goal evd content =
-    let info = Evd.find evd content in
-    let info =
-      { info with Evd.evar_source = match info.Evd.evar_source with
-      | _, (Evar_kinds.VarInstance _ | Evar_kinds.GoalEvar) as x -> x
-      | loc,_ -> loc,Evar_kinds.GoalEvar }
-    in
-    let info = match Evd.Store.get info.Evd.evar_extra typeclass_resolvable with
-    | None -> { info with Evd.evar_extra = Evd.Store.set info.Evd.evar_extra typeclass_resolvable () }
-    | Some () -> info
-    in
-    Evd.add evd content info
+    mark_in_evm ~goal:true evd content
+
+  let advance = Evarutil.advance
 
-  let advance = advance
+  let mark_as_unresolvable p gl =
+    { p with solution = mark_in_evm ~goal:false p.solution gl }
 
   let typeclass_resolvable = typeclass_resolvable
 
@@ -946,7 +1002,7 @@ let goal_extra evars gl =
 
 let catchable_exception = function
   | Logic_monad.Exception _ -> false
-  | e -> Errors.noncritical e
+  | e -> CErrors.noncritical e
 
 
 module Goal = struct
@@ -992,7 +1048,7 @@ module Goal = struct
         let (gl, sigma) = nf_gmake env sigma goal in
         tclTHEN (Unsafe.tclEVARS sigma) (InfoL.tag (Info.DBranch) (f.enter gl))
       with e when catchable_exception e ->
-        let (e, info) = Errors.push e in
+        let (e, info) = CErrors.push e in
         tclZERO ~info e
     end
     end
@@ -1015,11 +1071,31 @@ module Goal = struct
       tclEVARMAP >>= fun sigma ->
       try f (gmake env sigma goal)
       with e when catchable_exception e ->
-        let (e, info) = Errors.push e in
+        let (e, info) = CErrors.push e in
         tclZERO ~info e
     end
     end
 
+  exception NotExactlyOneSubgoal
+  let _ = CErrors.register_handler begin function
+  | NotExactlyOneSubgoal ->
+      CErrors.user_err (Pp.str"Not exactly one subgoal.")
+  | _ -> raise CErrors.Unhandled
+  end
+
+  let enter_one f =
+    let open Proof in
+    Comb.get >>= function
+    | [goal] -> begin
+       Env.get >>= fun env ->
+       tclEVARMAP >>= fun sigma ->
+       try f.enter (gmake env sigma goal)
+       with e when catchable_exception e ->
+         let (e, info) = CErrors.push e in
+         tclZERO ~info e
+      end
+    | _ -> tclZERO NotExactlyOneSubgoal
+
   type ('a, 'b) s_enter =
     { s_enter : 'r. ('a, 'r) t -> ('b, 'r) Sigma.sigma }
 
@@ -1034,7 +1110,7 @@ module Goal = struct
         let sigma = Sigma.to_evar_map sigma in
         tclTHEN (Unsafe.tclEVARS sigma) (InfoL.tag (Info.DBranch) tac)
       with e when catchable_exception e ->
-        let (e, info) = Errors.push e in
+        let (e, info) = CErrors.push e in
         tclZERO ~info e
     end
     end
@@ -1050,7 +1126,7 @@ module Goal = struct
         let sigma = Sigma.to_evar_map sigma in
         tclTHEN (Unsafe.tclEVARS sigma) (InfoL.tag (Info.DBranch) tac)
       with e when catchable_exception e ->
-        let (e, info) = Errors.push e in
+        let (e, info) = CErrors.push e in
         tclZERO ~info e
     end
     end
@@ -1059,7 +1135,7 @@ module Goal = struct
     Pv.get >>= fun step ->
     let sigma = step.solution in
     let map goal =
-      match advance sigma goal with
+      match Evarutil.advance sigma goal with
       | None -> None (** ppedrot: Is this check really necessary? *)
       | Some goal ->
         let gl =
@@ -1071,6 +1147,10 @@ module Goal = struct
     in
     tclUNIT (CList.map_filter map step.comb)
 
+  let unsolved { self=self } =
+    tclEVARMAP >>= fun sigma ->
+    tclUNIT (not (Option.is_empty (Evarutil.advance sigma self)))
+
   (* compatibility *)
   let goal { self=self } = self
 
@@ -1106,10 +1186,6 @@ let tclLIFT = Proof.lift
 let tclCHECKINTERRUPT =
    tclLIFT (NonLogical.make Control.check_for_interrupt)
 
-
-
-
-
 (*** Compatibility layer with <= 8.2 tactics ***)
 module V82 = struct
   type tac = Evar.t Evd.sigma -> Evar.t list Evd.sigma
@@ -1138,7 +1214,7 @@ module V82 = struct
       InfoL.leaf (Info.Tactic (fun () -> Pp.str"<unknown>")) >>
       Pv.set { ps with solution = evd; comb = sgs; }
     with e when catchable_exception e ->
-      let (e, info) = Errors.push e in
+      let (e, info) = CErrors.push e in
       tclZERO ~info e
 
 
@@ -1183,7 +1259,7 @@ module V82 = struct
       let (_,final,_,_) = apply (goal_env gls.Evd.sigma gls.Evd.it) t init in
       { Evd.sigma = final.solution ; it = final.comb }
     with Logic_monad.TacticFailure e as src ->
-      let (_, info) = Errors.push src in
+      let (_, info) = CErrors.push src in
       iraise (e, info)
 
   let put_status = Status.put
@@ -1193,7 +1269,7 @@ module V82 = struct
   let wrap_exceptions f =
     try f ()
     with e when catchable_exception e ->
-      let (e, info) = Errors.push e in tclZERO ~info e
+      let (e, info) = CErrors.push e in tclZERO ~info e
 
 end
 
diff --git a/engine/proofview.mli b/engine/proofview.mli
index 7996b7969..294b03dca 100644
--- a/engine/proofview.mli
+++ b/engine/proofview.mli
@@ -63,7 +63,7 @@ val dependent_init  : telescope -> entry * proofview
 
 (** [finished pv] is [true] if and only if [pv] is complete. That is,
     if it has an empty list of focused goals. There could still be
-    unsolved subgoaled, but they would then be out of focus. *)
+    unsolved subgoals, but they would then be out of focus. *)
 val finished : proofview -> bool
 
 (** Returns the current [evar] state. *)
@@ -239,6 +239,16 @@ val set_nosuchgoals_hook: (int -> Pp.std_ppcmds) -> unit
 
 val tclFOCUS : int -> int -> 'a tactic -> 'a tactic
 
+(** [tclFOCUSLIST li t] applies [t] on the list of focused goals
+    described by [li]. Each element of [li] is a pair [(i, j)] denoting
+    the goals numbered from [i] to [j] (inclusive, starting from 1).
+    It will try to apply [t] to all the valid goals in any of these
+    intervals. If the set of such goals is not a single range, then it
+    will move goals such that it is a single range. (So, for
+    instance, [[1, 3-5]; idtac.] is not the identity.)
+    If the set of such goals is empty, it will fail. *)
+val tclFOCUSLIST : (int * int) list -> 'a tactic -> 'a tactic
+
 (** [tclFOCUSID x t] applies [t] on a (single) focused goal like
     {!tclFOCUS}. The goal is found by its name rather than its
     number.*)
@@ -282,6 +292,7 @@ val tclEXTEND : unit tactic list -> unit tactic -> unit tactic list -> unit tact
     independent of backtracking in another. It is equivalent to
     [tclEXTEND [] tac []]. *)
 val tclINDEPENDENT : unit tactic -> unit tactic
+val tclINDEPENDENTL: 'a tactic -> 'a list tactic
 
 
 (** {7 Goal manipulation} *)
@@ -290,6 +301,16 @@ val tclINDEPENDENT : unit tactic -> unit tactic
     shelf for later use (or being solved by side-effects). *)
 val shelve : unit tactic
 
+(** Shelves the given list of goals, which might include some that are
+    under focus and some that aren't. All the goals are placed on the
+    shelf for later use (or being solved by side-effects). *)
+val shelve_goals : Goal.goal list -> unit tactic
+
+(** [unifiable sigma g l] checks whether [g] appears in another
+    subgoal of [l]. The list [l] may contain [g], but it does not
+    affect the result. Used by [shelve_unifiable]. *)
+val unifiable : Evd.evar_map -> Goal.goal -> Goal.goal list -> bool
+
 (** Shelves the unifiable goals under focus, i.e. the goals which
     appear in other goals under focus (the unfocused goals are not
     considered). *)
@@ -303,8 +324,12 @@ val guard_no_unifiable : Names.Name.t list option tactic
     goals of p *)
 val unshelve : Goal.goal list -> proofview -> proofview
 
-(** [with_shelf tac] executes [tac] and returns its result together with the set
-    of goals shelved by [tac]. The current shelf is unchanged. *)
+(** [depends_on g1 g2 sigma] checks if g1 occurs in the type/ctx of g2 *)
+val depends_on : Evd.evar_map -> Goal.goal -> Goal.goal -> bool
+
+(** [with_shelf tac] executes [tac] and returns its result together with
+    the set of goals shelved by [tac]. The current shelf is unchanged
+    and the returned list contains only unsolved goals. *)
 val with_shelf : 'a tactic -> (Goal.goal list * 'a) tactic
 
 (** If [n] is positive, [cycle n] puts the [n] first goal last. If [n]
@@ -349,7 +374,6 @@ val mark_as_unsafe : unit tactic
     with given up goals cannot be closed. *)
 val give_up : unit tactic
 
-
 (** {7 Control primitives} *)
 
 (** [tclPROGRESS t] checks the state of the proof after [t]. It it is
@@ -386,6 +410,9 @@ module Unsafe : sig
   (** Like {!tclEVARS} but also checks whether goals have been solved. *)
   val tclEVARSADVANCE : Evd.evar_map -> unit tactic
 
+  (** Set the global environment of the tactic *)
+  val tclSETENV : Environ.env -> unit tactic
+
   (** [tclNEWGOALS gls] adds the goals [gls] to the ones currently
       being proved, appending them to the list of focused goals. If a
       goal is already solved, it is not added. *)
@@ -408,6 +435,9 @@ module Unsafe : sig
       and makes it unresolvable for type classes. *)
   val mark_as_goal : Evd.evar_map -> Evar.t -> Evd.evar_map
 
+  (** Make an evar unresolvable for type classes. *)
+  val mark_as_unresolvable : proofview -> Evar.t -> proofview
+
   (** [advance sigma g] returns [Some g'] if [g'] is undefined and is
       the current avatar of [g] (for instance [g] was changed by [clear]
       into [g']). It returns [None] if [g] has been (partially)
@@ -476,6 +506,10 @@ module Goal : sig
   (** Like {!nf_enter}, but does not normalize the goal beforehand. *)
   val enter : ([ `LZ ], unit tactic) enter -> unit tactic
 
+  (** Like {!enter}, but assumes exactly one goal under focus, raising *)
+  (** an error otherwise. *)
+  val enter_one : ([ `LZ ], 'a tactic) enter -> 'a tactic
+
   type ('a, 'b) s_enter =
     { s_enter : 'r. ('a, 'r) t -> ('b, 'r) Sigma.sigma }
 
@@ -491,6 +525,10 @@ module Goal : sig
       FIXME: encapsulate the level in an existential type. *)
   val goals : ([ `LZ ], 'r) t tactic list tactic
 
+  (** [unsolved g] is [true] if [g] is still unsolved in the current
+      proof state. *)
+  val unsolved : ('a, 'r) t -> bool tactic
+
   (** Compatibility: avoid if possible *)
   val goal : ([ `NF ], 'r) t -> Evar.t
 
diff --git a/engine/proofview_monad.mli b/engine/proofview_monad.mli
index 0aff0a720..637414cce 100644
--- a/engine/proofview_monad.mli
+++ b/engine/proofview_monad.mli
@@ -7,7 +7,8 @@
 (************************************************************************)
 
 (** This file defines the datatypes used as internal states by the
-    tactic monad, and specialises the [Logic_monad] to these type. *)
+    tactic monad, and specialises the [Logic_monad] to these types. It should
+    not be used directly. Consider using {!Proofview} instead. *)
 
 (** {6 Traces} *)
 
diff --git a/engine/sigma.ml b/engine/sigma.ml
index c7b0bb5a5..9381a33af 100644
--- a/engine/sigma.ml
+++ b/engine/sigma.ml
@@ -36,16 +36,16 @@ let new_evar sigma ?naming info =
 let define evk c sigma =
   Sigma ((), Evd.define evk c sigma, ())
 
-let new_univ_level_variable ?loc ?name ?predicative rigid sigma =
-  let (sigma, u) = Evd.new_univ_level_variable ?loc ?name ?predicative rigid sigma in
+let new_univ_level_variable ?loc ?name rigid sigma =
+  let (sigma, u) = Evd.new_univ_level_variable ?loc ?name rigid sigma in
   Sigma (u, sigma, ())
 
-let new_univ_variable ?loc ?name ?predicative rigid sigma =
-  let (sigma, u) = Evd.new_univ_variable ?loc ?name ?predicative rigid sigma in
+let new_univ_variable ?loc ?name rigid sigma =
+  let (sigma, u) = Evd.new_univ_variable ?loc ?name rigid sigma in
   Sigma (u, sigma, ())
 
-let new_sort_variable ?loc ?name ?predicative rigid sigma =
-  let (sigma, u) = Evd.new_sort_variable ?loc ?name ?predicative rigid sigma in
+let new_sort_variable ?loc ?name rigid sigma =
+  let (sigma, u) = Evd.new_sort_variable ?loc ?name rigid sigma in
   Sigma (u, sigma, ())
 
 let fresh_sort_in_family ?loc ?rigid env sigma s =
diff --git a/engine/sigma.mli b/engine/sigma.mli
index 643bea403..7473a251b 100644
--- a/engine/sigma.mli
+++ b/engine/sigma.mli
@@ -12,7 +12,9 @@ open Constr
 (** Monotonous state enforced by typing.
 
     This module allows to constrain uses of evarmaps in a monotonous fashion,
-    and in particular statically suppress evar leaks and the like.
+    and in particular statically suppress evar leaks and the like. To this
+    ends, it defines a type of indexed evarmaps whose phantom typing ensures
+    monotonous use.
 *)
 
 (** {5 Stages} *)
@@ -32,7 +34,7 @@ val (+>) : ('a, 'b) le -> ('b, 'c) le -> ('a, 'c) le
 (** {5 Monotonous evarmaps} *)
 
 type 'r t
-(** Stage-indexed evarmaps.  *)
+(** Stage-indexed evarmaps. This is just a plain evarmap with a phantom type. *)
 
 type ('a, 'r) sigma = Sigma : 'a * 's t * ('r, 's) le -> ('a, 'r) sigma
 (** Return values at a later stage *)
@@ -66,11 +68,11 @@ val define : 'r evar -> Constr.t -> 'r t -> (unit, 'r) sigma
 
 (** Polymorphic universes *)
 
-val new_univ_level_variable : ?loc:Loc.t -> ?name:string -> ?predicative:bool ->
+val new_univ_level_variable : ?loc:Loc.t -> ?name:string ->
   Evd.rigid -> 'r t -> (Univ.universe_level, 'r) sigma
-val new_univ_variable : ?loc:Loc.t -> ?name:string -> ?predicative:bool ->
+val new_univ_variable : ?loc:Loc.t -> ?name:string ->
   Evd.rigid -> 'r t -> (Univ.universe, 'r) sigma
-val new_sort_variable : ?loc:Loc.t -> ?name:string -> ?predicative:bool ->
+val new_sort_variable : ?loc:Loc.t -> ?name:string ->
   Evd.rigid -> 'r t -> (Sorts.t, 'r) sigma
 
 val fresh_sort_in_family : ?loc:Loc.t -> ?rigid:Evd.rigid -> Environ.env ->
diff --git a/engine/termops.ml b/engine/termops.ml
index f698f8151..2f4c5e204 100644
--- a/engine/termops.ml
+++ b/engine/termops.ml
@@ -7,7 +7,7 @@
 (************************************************************************)
 
 open Pp
-open Errors
+open CErrors
 open Util
 open Names
 open Nameops
@@ -17,6 +17,7 @@ open Environ
 
 module RelDecl = Context.Rel.Declaration
 module NamedDecl = Context.Named.Declaration
+module CompactedDecl = Context.Compacted.Declaration
 
 (* Sorts and sort family *)
 
@@ -100,6 +101,7 @@ 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 () = Hook.set Evd.print_constr_hook (fun env c -> !term_printer env c)
 
 let pr_var_decl env decl =
   let open NamedDecl in
@@ -564,7 +566,14 @@ let occur_var_in_decl env hyp decl =
         occur_var env hyp typ ||
         occur_var env hyp body
 
-(* returns the list of free debruijn indices in a term *)
+let local_occur_var id c =
+  let rec occur c = match kind_of_term c with
+  | Var id' -> if Id.equal id id' then raise Occur
+  | _ -> Constr.iter occur c
+  in
+  try occur c; false with Occur -> true
+
+  (* returns the list of free debruijn indices in a term *)
 
 let free_rels m =
   let rec frec depth acc c = match kind_of_term c with
@@ -592,11 +601,18 @@ let collect_vars c =
   | _ -> fold_constr aux vars c in
   aux Id.Set.empty c
 
+let vars_of_global_reference env gr =
+  let c, _ = Universes.unsafe_constr_of_global gr in
+  vars_of_global (Global.env ()) c
+
 (* Tests whether [m] is a subterm of [t]:
    [m] is appropriately lifted through abstractions of [t] *)
 
 let dependent_main noevar univs m t =
-  let eqc x y = if univs then fst (Universes.eq_constr_universes x y) else eq_constr_nounivs x y in
+  let eqc x y =
+    if univs then not (Option.is_empty (Universes.eq_constr_universes x y))
+    else eq_constr_nounivs x y
+  in
   let rec deprec m t =
     if eqc m t then
       raise Occur
@@ -662,6 +678,21 @@ let rec subst_meta bl c =
     | Meta i -> (try Int.List.assoc i bl with Not_found -> c)
     | _ -> map_constr (subst_meta bl) c
 
+let rec strip_outer_cast c = match kind_of_term c with
+  | Cast (c,_,_) -> strip_outer_cast c
+  | _ -> c
+
+(* flattens application lists throwing casts in-between *)
+let collapse_appl c = match kind_of_term c with
+  | App (f,cl) ->
+      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)
+        | _ -> mkApp (f,cl2)
+      in
+      collapse_rec f cl
+  | _ -> c
+
 (* First utilities for avoiding telescope computation for subst_term *)
 
 let prefix_application eq_fun (k,c) (t : constr) =
@@ -968,24 +999,30 @@ let smash_rel_context sign =
 
 let fold_named_context_both_sides f l ~init = List.fold_right_and_left f l init
 
-let rec mem_named_context id ctxt =
-  match ctxt with
-  | decl :: _ when Id.equal id (NamedDecl.get_id decl) -> true
-  | _ :: sign -> mem_named_context id sign
-  | [] -> false
+let mem_named_context_val id ctxt =
+  try ignore(Environ.lookup_named_val id ctxt); true with Not_found -> false
 
-let compact_named_context_reverse sign =
+let compact_named_context sign =
   let compact l decl =
-    let (i1,c1,t1) = NamedDecl.to_tuple decl in
-    match l with
-    | [] -> [[i1],c1,t1]
-    | (l2,c2,t2)::q ->
-       if Option.equal Constr.equal c1 c2 && Constr.equal t1 t2
-       then (i1::l2,c2,t2)::q
-       else ([i1],c1,t1)::l
-  in Context.Named.fold_inside compact ~init:[] sign
-
-let compact_named_context sign = List.rev (compact_named_context_reverse sign)
+    match decl, l with
+    | NamedDecl.LocalAssum (i,t), [] ->
+       [CompactedDecl.LocalAssum ([i],t)]
+    | NamedDecl.LocalDef (i,c,t), [] ->
+       [CompactedDecl.LocalDef ([i],c,t)]
+    | NamedDecl.LocalAssum (i1,t1), CompactedDecl.LocalAssum (li,t2) :: q ->
+       if Constr.equal t1 t2
+       then CompactedDecl.LocalAssum (i1::li, t2) :: q
+       else CompactedDecl.LocalAssum ([i1],t1) :: CompactedDecl.LocalAssum (li,t2) :: q
+    | NamedDecl.LocalDef (i1,c1,t1), CompactedDecl.LocalDef (li,c2,t2) :: q ->
+       if Constr.equal c1 c2 && Constr.equal t1 t2
+       then CompactedDecl.LocalDef (i1::li, c2, t2) :: q
+       else CompactedDecl.LocalDef ([i1],c1,t1) :: CompactedDecl.LocalDef (li,c2,t2) :: q
+    | NamedDecl.LocalAssum (i,t), q ->
+       CompactedDecl.LocalAssum ([i],t) :: q
+    | NamedDecl.LocalDef (i,c,t), q ->
+       CompactedDecl.LocalDef ([i],c,t) :: q
+  in
+  sign |> Context.Named.fold_inside compact ~init:[] |> List.rev
 
 let clear_named_body id env =
   let open NamedDecl in
diff --git a/engine/termops.mli b/engine/termops.mli
index c2a4f3323..78826f79a 100644
--- a/engine/termops.mli
+++ b/engine/termops.mli
@@ -6,6 +6,9 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
+(** This file defines various utilities for term manipulation that are not
+    needed in the kernel. *)
+
 open Pp
 open Names
 open Term
@@ -93,6 +96,7 @@ val strip_head_cast : constr -> constr
 val drop_extra_implicit_args : constr -> constr
 
 (** occur checks *)
+
 exception Occur
 val occur_meta : types -> bool
 val occur_existential : types -> bool
@@ -102,6 +106,10 @@ val occur_var : env -> Id.t -> types -> bool
 val occur_var_in_decl :
   env ->
   Id.t -> Context.Named.Declaration.t -> bool
+
+(** As {!occur_var} but assume the identifier not to be a section variable *)
+val local_occur_var : Id.t -> types -> bool
+
 val free_rels : constr -> Int.Set.t
 
 (** [dependent m t] tests whether [m] is a subterm of [t] *)
@@ -113,6 +121,7 @@ val dependent_in_decl : constr -> Context.Named.Declaration.t -> bool
 val count_occurrences : constr -> constr -> int
 val collect_metas : constr -> int list
 val collect_vars : constr -> Id.Set.t (** for visible vars only *)
+val vars_of_global_reference : env -> Globnames.global_reference -> Id.Set.t
 val occur_term : constr -> constr -> bool (** Synonymous
  of dependent 
    Substitution of metavariables *)
@@ -155,6 +164,13 @@ val eq_constr : constr -> constr -> bool (* FIXME rename: erases universes*)
 
 val eta_reduce_head : constr -> constr
 
+(** Flattens application lists *)
+val collapse_appl : constr -> constr
+
+(** Remove recursively the casts around a term i.e.
+   [strip_outer_cast (Cast (Cast ... (Cast c, t) ... ))] is [c]. *)
+val strip_outer_cast : constr -> constr
+
 exception CannotFilter
 
 (** Lightweight first-order filtering procedure. Unification
@@ -229,9 +245,8 @@ val map_rel_context_with_binders :
 val fold_named_context_both_sides :
   ('a -> Context.Named.Declaration.t -> Context.Named.Declaration.t list -> 'a) ->
     Context.Named.t -> init:'a -> 'a
-val mem_named_context : Id.t -> Context.Named.t -> bool
-val compact_named_context : Context.Named.t -> Context.NamedList.t
-val compact_named_context_reverse : Context.Named.t -> Context.NamedList.t
+val mem_named_context_val : Id.t -> named_context_val -> bool
+val compact_named_context : Context.Named.t -> Context.Compacted.t
 
 val clear_named_body : Id.t -> env -> env
 
diff --git a/engine/uState.ml b/engine/uState.ml
index 8aa9a61ab..c66af02bb 100644
--- a/engine/uState.ml
+++ b/engine/uState.ml
@@ -7,7 +7,7 @@
 (************************************************************************)
 
 open Pp
-open Errors
+open CErrors
 open Util
 open Names
 
@@ -49,7 +49,7 @@ let empty =
     uctx_univ_variables = Univ.LMap.empty;
     uctx_univ_algebraic = Univ.LSet.empty;
     uctx_universes = UGraph.initial_universes;
-    uctx_initial_universes = UGraph.initial_universes }
+    uctx_initial_universes = UGraph.initial_universes; }
 
 let make u =
     { empty with 
@@ -83,7 +83,7 @@ let union ctx ctx' =
           if local == ctx.uctx_local then ctx.uctx_universes
           else
             let cstrsr = Univ.ContextSet.constraints ctx'.uctx_local in
-              UGraph.merge_constraints cstrsr (declarenew ctx.uctx_universes) }
+            UGraph.merge_constraints cstrsr (declarenew ctx.uctx_universes) }
 
 let context_set ctx = ctx.uctx_local
 
@@ -255,21 +255,25 @@ let universe_context ?names ctx =
           let l =
             try UNameMap.find (Id.to_string id) (fst ctx.uctx_names)
             with Not_found ->
-              user_err_loc (loc, "universe_context",
-                            str"Universe " ++ Nameops.pr_id id ++ str" is not bound anymore.")
+              user_err ~loc ~hdr:"universe_context"
+                            (str"Universe " ++ Nameops.pr_id id ++ str" is not bound anymore.")
           in (l :: newinst, (id, l) :: map, Univ.LSet.remove l acc))
          pl ([], [], levels)
      in
        if not (Univ.LSet.is_empty left) then
          let n = Univ.LSet.cardinal left in
          let loc =
-          let get_loc u = try (Univ.LMap.find u (snd ctx.uctx_names)).uloc with Not_found -> None in
-          try List.find_map get_loc (Univ.LSet.elements left) with Not_found -> Loc.ghost
+           try
+             let info =
+               Univ.LMap.find (Univ.LSet.choose left) (snd ctx.uctx_names) in
+             Option.default Loc.ghost info.uloc
+           with Not_found -> Loc.ghost
          in
-           user_err_loc (loc, "universe_context",
-                        (str(CString.plural n "Universe") ++ spc () ++
-                             Univ.LSet.pr (pr_uctx_level ctx) left ++
-                             spc () ++ str (CString.conjugate_verb_to_be n) ++ str" unbound."))
+           user_err ~loc ~hdr:"universe_context"
+                        ((str(CString.plural n "Universe") ++ spc () ++
+			     Univ.LSet.pr (pr_uctx_level ctx) left ++
+			   spc () ++ str (CString.conjugate_verb_to_be n) ++
+                           str" unbound."))
       else
         let inst = Univ.Instance.of_array (Array.of_list newinst) in
         let ctx = Univ.UContext.make (inst,
@@ -329,7 +333,8 @@ let merge ?loc sideff rigid uctx ctx' =
   let initial = declare uctx.uctx_initial_universes in
   let univs = declare uctx.uctx_universes in
   let uctx_universes = UGraph.merge_constraints (ContextSet.constraints ctx') univs in
-    { uctx with uctx_names; uctx_local; uctx_universes; uctx_initial_universes = initial }
+  { uctx with uctx_names; uctx_local; uctx_universes;
+              uctx_initial_universes = initial }
 
 let merge_subst uctx s =
   { uctx with uctx_univ_variables = Univ.LMap.subst_union uctx.uctx_univ_variables s }
diff --git a/engine/uState.mli b/engine/uState.mli
index c5c454020..0cdc6277a 100644
--- a/engine/uState.mli
+++ b/engine/uState.mli
@@ -6,7 +6,9 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(** Universe unification states *)
+(** This file defines universe unification states which are part of evarmaps.
+    Most of the API below is reexported in {!Evd}. Consider using higher-level
+    primitives when needed. *)
 
 open Names
 
diff --git a/library/universes.ml b/engine/universes.ml
index c4eb2afcb..6720fcef8 100644
--- a/library/universes.ml
+++ b/engine/universes.ml
@@ -13,20 +13,10 @@ open Term
 open Environ
 open Univ
 open Globnames
-
-(** Global universe names *)
-type universe_names = 
-    Univ.universe_level Idmap.t * Id.t Univ.LMap.t
-
-let global_universes =
-  Summary.ref ~name:"Global universe names"
-  ((Idmap.empty, Univ.LMap.empty) : universe_names)
-
-let global_universe_names () = !global_universes
-let set_global_universe_names s = global_universes := s
+open Decl_kinds
 
 let pr_with_global_universes l = 
-  try Nameops.pr_id (LMap.find l (snd !global_universes))
+  try Nameops.pr_id (LMap.find l (snd (Global.global_universe_names ())))
   with Not_found -> Level.pr l
 
 (** Local universe names of polymorphic references *)
@@ -111,7 +101,7 @@ let enforce_eq_instances_univs strict x y c =
   let d = if strict then ULub else UEq in
   let ax = Instance.to_array x and ay = Instance.to_array y in
     if Array.length ax != Array.length ay then
-      Errors.anomaly (Pp.str "Invalid argument: enforce_eq_instances_univs called with" ++
+      CErrors.anomaly (Pp.str "Invalid argument: enforce_eq_instances_univs called with" ++
 	       Pp.str " instances of different lengths");
     CArray.fold_right2
       (fun x y -> Constraints.add (Universe.make x, d, Universe.make y))
@@ -142,11 +132,11 @@ let to_constraints g s =
 		   "to_constraints: non-trivial algebraic constraint between universes")
   in Constraints.fold tr s Constraint.empty
 
-let eq_constr_univs_infer univs fold m n accu =
+let test_constr_univs_infer leq univs fold m n accu =
   if m == n then Some accu
   else 
     let cstrs = ref accu in
-    let eq_universes strict = UGraph.check_eq_instances univs in
+    let eq_universes strict l l' = UGraph.check_eq_instances univs l l' in
     let eq_sorts s1 s2 = 
       if Sorts.equal s1 s2 then true
       else
@@ -155,12 +145,34 @@ let eq_constr_univs_infer univs fold m n accu =
 	| None -> false
 	| Some accu -> cstrs := accu; true
     in
+    let leq_sorts s1 s2 = 
+      if Sorts.equal s1 s2 then true
+      else 
+	let u1 = Sorts.univ_of_sort s1 and u2 = Sorts.univ_of_sort s2 in
+	match fold (Constraints.singleton (u1, ULe, u2)) !cstrs with
+	| None -> false
+	| Some accu -> cstrs := accu; true
+    in
     let rec eq_constr' m n = 
       m == n ||	Constr.compare_head_gen eq_universes eq_sorts eq_constr' m n
     in
-    let res = Constr.compare_head_gen eq_universes eq_sorts eq_constr' m n in
+    let res =
+      if leq then
+        let rec compare_leq m n =
+          Constr.compare_head_gen_leq eq_universes leq_sorts 
+            eq_constr' leq_constr' m n
+        and leq_constr' m n = m == n || compare_leq m n in
+        compare_leq m n
+      else Constr.compare_head_gen eq_universes eq_sorts eq_constr' m n
+    in
     if res then Some !cstrs else None
 
+let eq_constr_univs_infer univs fold m n accu =
+  test_constr_univs_infer false univs fold m n accu
+
+let leq_constr_univs_infer univs fold m n accu =
+  test_constr_univs_infer true univs fold m n accu
+
 (** Variant of [eq_constr_univs_infer] taking kind-of-term functions,
     to expose subterms of [m] and [n], arguments. *)
 let eq_constr_univs_infer_with kind1 kind2 univs fold m n accu =
@@ -186,58 +198,8 @@ let eq_constr_univs_infer_with kind1 kind2 univs fold m n accu =
   let res = Constr.compare_head_gen_with kind1 kind2 eq_universes eq_sorts eq_constr' m n in
   if res then Some !cstrs else None
 
-let leq_constr_univs_infer univs fold m n accu =
-  if m == n then Some accu
-  else 
-    let cstrs = ref accu in
-    let eq_universes strict l l' = UGraph.check_eq_instances univs l l' in
-    let eq_sorts s1 s2 = 
-      if Sorts.equal s1 s2 then true
-      else
-	let u1 = Sorts.univ_of_sort s1 and u2 = Sorts.univ_of_sort s2 in
-	match fold (Constraints.singleton (u1, UEq, u2)) !cstrs with
-	| None -> false
-	| Some accu -> cstrs := accu; true
-    in
-    let leq_sorts s1 s2 = 
-      if Sorts.equal s1 s2 then true
-      else 
-	let u1 = Sorts.univ_of_sort s1 and u2 = Sorts.univ_of_sort s2 in
-	match fold (Constraints.singleton (u1, ULe, u2)) !cstrs with
-	| None -> false
-	| Some accu -> cstrs := accu; true
-    in
-    let rec eq_constr' m n = 
-      m == n ||	Constr.compare_head_gen eq_universes eq_sorts eq_constr' m n
-    in
-    let rec compare_leq m n =
-      Constr.compare_head_gen_leq eq_universes leq_sorts 
-	eq_constr' leq_constr' m n
-    and leq_constr' m n = m == n || compare_leq m n in
-    let res = compare_leq m n in
-    if res then Some !cstrs else None
-
-let eq_constr_universes m n =
-  if m == n then true, Constraints.empty
-  else 
-    let cstrs = ref Constraints.empty in
-    let eq_universes strict l l' = 
-      cstrs := enforce_eq_instances_univs strict l l' !cstrs; true in
-    let eq_sorts s1 s2 = 
-      if Sorts.equal s1 s2 then true
-      else
-	(cstrs := Constraints.add 
-	   (Sorts.univ_of_sort s1, UEq, Sorts.univ_of_sort s2) !cstrs;
-	 true)
-    in
-    let rec eq_constr' m n = 
-      m == n ||	Constr.compare_head_gen eq_universes eq_sorts eq_constr' m n
-    in
-    let res = Constr.compare_head_gen eq_universes eq_sorts eq_constr' m n in
-    res, !cstrs
-
-let leq_constr_universes m n =
-  if m == n then true, Constraints.empty
+let test_constr_universes leq m n =
+  if m == n then Some Constraints.empty
   else 
     let cstrs = ref Constraints.empty in
     let eq_universes strict l l' = 
@@ -258,11 +220,19 @@ let leq_constr_universes m n =
     let rec eq_constr' m n = 
       m == n ||	Constr.compare_head_gen eq_universes eq_sorts eq_constr' m n
     in
-    let rec compare_leq m n =
-      Constr.compare_head_gen_leq eq_universes leq_sorts eq_constr' leq_constr' m n
-    and leq_constr' m n = m == n || compare_leq m n in
-    let res = compare_leq m n in
-    res, !cstrs
+    let res =
+      if leq then
+        let rec compare_leq m n =
+          Constr.compare_head_gen_leq eq_universes leq_sorts eq_constr' leq_constr' m n
+        and leq_constr' m n = m == n || compare_leq m n in
+        compare_leq m n
+      else
+        Constr.compare_head_gen eq_universes eq_sorts eq_constr' m n
+    in
+    if res then Some !cstrs else None
+
+let eq_constr_universes m n = test_constr_universes false m n
+let leq_constr_universes m n = test_constr_universes true m n
 
 let compare_head_gen_proj env equ eqs eqc' m n =
   match kind_of_term m, kind_of_term n with
@@ -336,7 +306,7 @@ let existing_instance ctx inst =
     and a2 = Instance.to_array (UContext.instance ctx) in
     let len1 = Array.length a1 and len2 = Array.length a2 in 
       if not (len1 == len2) then
-	Errors.errorlabstrm "Universes"
+	CErrors.user_err ~hdr:"Universes"
 	  (str "Polymorphic constant expected " ++ int len2 ++ 
 	     str" levels but was given " ++ int len1)
       else ()
@@ -701,12 +671,45 @@ let pr_universe_body = function
 
 let pr_universe_opt_subst = Univ.LMap.pr pr_universe_body
 
-exception Found of Level.t
+let compare_constraint_type d d' =
+  match d, d' with
+  | Eq, Eq -> 0
+  | Eq, _ -> -1
+  | _, Eq -> 1
+  | Le, Le -> 0
+  | Le, _ -> -1
+  | _, Le -> 1
+  | Lt, Lt -> 0
+
+type lowermap = constraint_type LMap.t
+
+let lower_union =
+  let merge k a b =
+    match a, b with
+    | Some _, None -> a
+    | None, Some _ -> b
+    | None, None -> None
+    | Some l, Some r ->
+       if compare_constraint_type l r >= 0 then a
+       else b
+  in LMap.merge merge
+
+let lower_add l c m =
+  try let c' = LMap.find l m in
+      if compare_constraint_type c c' > 0 then
+        LMap.add l c m
+      else m
+  with Not_found -> LMap.add l c m
+
+let lower_of_list l =
+  List.fold_left (fun acc (d,l) -> LMap.add l d acc) LMap.empty l
+
+exception Found of Level.t * lowermap
 let find_inst insts v =
-  try LMap.iter (fun k (enf,alg,v') ->
-    if not alg && enf && Universe.equal v' v then raise (Found k))
+  try LMap.iter (fun k (enf,alg,v',lower) ->
+    if not alg && enf && Universe.equal v' v then raise (Found (k, lower)))
 	insts; raise Not_found
-  with Found l -> l
+  with Found (f,l) -> (f,l)
 
 let compute_lbound left =
  (** The universe variable was not fixed yet.
@@ -725,27 +728,33 @@ let compute_lbound left =
 	 else None))
       None left
   
-let instantiate_with_lbound u lbound alg enforce (ctx, us, algs, insts, cstrs) =
+let instantiate_with_lbound u lbound lower alg enforce (ctx, us, algs, insts, cstrs) =
   if enforce then
     let inst = Universe.make u in
     let cstrs' = enforce_leq lbound inst cstrs in
       (ctx, us, LSet.remove u algs, 
-       LMap.add u (enforce,alg,lbound) insts, cstrs'), (enforce, alg, inst)
+       LMap.add u (enforce,alg,lbound,lower) insts, cstrs'),
+      (enforce, alg, inst, lower)
   else (* Actually instantiate *)
     (Univ.LSet.remove u ctx, Univ.LMap.add u (Some lbound) us, algs,
-     LMap.add u (enforce,alg,lbound) insts, cstrs), (enforce, alg, lbound)
+     LMap.add u (enforce,alg,lbound,lower) insts, cstrs),
+    (enforce, alg, lbound, lower)
 
 type constraints_map = (Univ.constraint_type * Univ.LMap.key) list Univ.LMap.t
 
 let pr_constraints_map cmap =
   LMap.fold (fun l cstrs acc -> 
     Level.pr l ++ str " => " ++ 
-      prlist_with_sep spc (fun (d,r) -> pr_constraint_type d ++ Level.pr r) cstrs ++ fnl ()
-    ++ acc)
+      prlist_with_sep spc (fun (d,r) -> pr_constraint_type d ++ Level.pr r) cstrs ++
+      fnl () ++ acc)
     cmap (mt ())
 
 let remove_alg l (ctx, us, algs, insts, cstrs) =
   (ctx, us, LSet.remove l algs, insts, cstrs)
+
+let remove_lower u lower =
+  let levels = Universe.levels u in
+  LSet.fold (fun l acc -> LMap.remove l acc) levels lower
     
 let minimize_univ_variables ctx us algs left right cstrs =
   let left, lbounds = 
@@ -755,22 +764,50 @@ let minimize_univ_variables ctx us algs left right cstrs =
 	let lbounds' = 
 	  match compute_lbound (List.map (fun (d,l) -> d, Universe.make l) lower) with
 	  | None -> lbounds
-	  | Some lbound -> LMap.add r (true, false, lbound) lbounds
+	  | Some lbound -> LMap.add r (true, false, lbound, lower_of_list lower)
+                                   lbounds
 	in (Univ.LMap.remove r left, lbounds'))
       left (left, Univ.LMap.empty)
   in
   let rec instance (ctx', us, algs, insts, cstrs as acc) u =
-    let acc, left = 
-      try let l = LMap.find u left in
-	    List.fold_left
-	      (fun (acc, left') (d, l) -> 
-	       let acc', (enf,alg,l') = aux acc l in
-	       let l' = 
-		 if enf then Universe.make l 
-		 else l' 
-	       in acc', (d, l') :: left')
-	      (acc, []) l
-      with Not_found -> acc, []
+    let acc, left, lower =
+      try
+        let l = LMap.find u left in
+	let acc, left, newlow, lower =
+          List.fold_left
+	  (fun (acc, left', newlow, lower') (d, l) ->
+	   let acc', (enf,alg,l',lower) = aux acc l in
+	   let l' =
+	     if enf then Universe.make l
+	     else l'
+	   in acc', (d, l') :: left',
+              lower_add l d newlow, lower_union lower lower')
+	  (acc, [], LMap.empty, LMap.empty) l
+        in
+        let not_lower (d,l) =
+        (* We're checking if (d,l) is already implied by the lower
+	  constraints on some level u. If it represents l < u (d is Lt
+	  or d is Le and i > 0, the i < 0 case is impossible due to
+	  invariants of Univ), and the lower constraints only have l <=
+	  u then it is not implied. *)
+          Univ.Universe.exists
+          (fun (l,i) ->
+             let d =
+               if i == 0 then d
+               else match d with
+                    | Le -> Lt
+                    | d -> d
+             in
+             try let d' = LMap.find l lower in
+                 (* If d is stronger than the already implied lower
+                  * constraints we must keep it. *)
+                 compare_constraint_type d d' > 0
+             with Not_found ->
+               (** No constraint existing on l *) true) l
+        in
+        let left = List.uniquize (List.filter not_lower left) in
+        (acc, left, LMap.union newlow lower)
+      with Not_found -> acc, [], LMap.empty
     and right =
       try Some (LMap.find u right)
       with Not_found -> None
@@ -778,31 +815,33 @@ let minimize_univ_variables ctx us algs left right cstrs =
     let instantiate_lbound lbound =
       let alg = LSet.mem u algs in
 	if alg then
-	  (* u is algebraic: we instantiate it with it's lower bound, if any, 
+	  (* u is algebraic: we instantiate it with its lower bound, if any,
               or enforce the constraints if it is bounded from the top. *)
-	  instantiate_with_lbound u lbound true false acc
+          let lower = remove_lower lbound lower in
+	  instantiate_with_lbound u lbound lower true false acc
 	else (* u is non algebraic *)
 	  match Universe.level lbound with
 	  | Some l -> (* The lowerbound is directly a level *) 
 	     (* u is not algebraic but has no upper bounds,
   	        we instantiate it with its lower bound if it is a 
 	        different level, otherwise we keep it. *)
+             let lower = LMap.remove l lower in
 	     if not (Level.equal l u) then
 	       (* Should check that u does not 
   	          have upper constraints that are not already in right *)
 	       let acc' = remove_alg l acc in
-		 instantiate_with_lbound u lbound false false acc'
-	     else acc, (true, false, lbound)
-	| None -> 
-	  try 
-	    (* if right <> None then raise Not_found; *)
-	    (* Another universe represents the same lower bound, 
-	       we can share them with no harm. *)
-	    let can = find_inst insts lbound in
-	      instantiate_with_lbound u (Universe.make can) false false acc
+		 instantiate_with_lbound u lbound lower false false acc'
+	     else acc, (true, false, lbound, lower)
+	  | None ->
+	     try
+	       (* Another universe represents the same lower bound,
+                  we can share them with no harm. *)
+	       let can, lower = find_inst insts lbound in
+               let lower = LMap.remove can lower in
+	       instantiate_with_lbound u (Universe.make can) lower false false acc
 	  with Not_found -> 
 	    (* We set u as the canonical universe representing lbound *)
-	    instantiate_with_lbound u lbound false true acc
+	    instantiate_with_lbound u lbound lower false true acc
     in
     let acc' acc = 
       match right with
@@ -811,7 +850,7 @@ let minimize_univ_variables ctx us algs left right cstrs =
 	let dangling = List.filter (fun (d, r) -> not (LMap.mem r us)) cstrs in
 	  if List.is_empty dangling then acc
 	  else
-	    let ((ctx', us, algs, insts, cstrs), (enf,_,inst as b)) = acc in
+	    let ((ctx', us, algs, insts, cstrs), (enf,_,inst,lower as b)) = acc in
 	    let cstrs' = List.fold_left (fun cstrs (d, r) -> 
 	      if d == Univ.Le then
 		enforce_leq inst (Universe.make r) cstrs
@@ -823,15 +862,15 @@ let minimize_univ_variables ctx us algs left right cstrs =
 	    in
 	      (ctx', us, algs, insts, cstrs'), b
     in
-      if not (LSet.mem u ctx) then acc' (acc, (true, false, Universe.make u))
+      if not (LSet.mem u ctx) then acc' (acc, (true, false, Universe.make u, lower))
       else
 	let lbound = compute_lbound left in
 	  match lbound with
 	  | None -> (* Nothing to do *)
-	    acc' (acc, (true, false, Universe.make u))
+	    acc' (acc, (true, false, Universe.make u, lower))
 	  | Some lbound ->
 	     try acc' (instantiate_lbound lbound) 
-	     with Failure _ -> acc' (acc, (true, false, Universe.make u))
+	     with Failure _ -> acc' (acc, (true, false, Universe.make u, lower))
   and aux (ctx', us, algs, seen, cstrs as acc) u =
     try acc, LMap.find u seen 
     with Not_found -> instance acc u
@@ -925,9 +964,7 @@ let normalize_context_set ctx us algs =
      mentionning other variables remain in noneqs. *)
   let noneqs, ucstrsl, ucstrsr = 
     Constraint.fold (fun (l,d,r as cstr) (noneq, ucstrsl, ucstrsr) -> 
-      let lus = LMap.mem l us 
-      and rus = LMap.mem r us
-      in
+      let lus = LMap.mem l us and rus = LMap.mem r us in
       let ucstrsl' = 
 	if lus then add_list_map l (d, r) ucstrsl
 	else ucstrsl
@@ -1089,13 +1126,6 @@ let solve_constraints_system levels level_bounds level_min =
     for j=0 to nind-1 do
       if not (Int.equal i j) && Int.Set.mem j clos.(i) then
 	(v.(i) <- Universe.sup v.(i) level_bounds.(j));
-	 (* level_min.(i) <- Universe.sup level_min.(i) level_min.(j)) *)
     done;
-    (* for j=0 to nind-1 do *)
-    (*   match levels.(j) with *)
-    (*   | Some u when not (Univ.Level.is_small u) -> *)
-    (* 	 v.(i) <- univ_level_rem u v.(i) level_min.(i) *)
-    (*   | _ -> () *)
-    (* done *)
   done;
   v
diff --git a/library/universes.mli b/engine/universes.mli
index 53cf5f384..725c21d29 100644
--- a/library/universes.mli
+++ b/engine/universes.mli
@@ -17,13 +17,6 @@ val is_set_minimization : unit -> bool
 
 (** Universes *)
 
-(** Global universe name <-> level mapping *)
-type universe_names = 
-  Univ.universe_level Idmap.t * Id.t Univ.LMap.t
-
-val global_universe_names : unit -> universe_names
-val set_global_universe_names : universe_names -> unit
-
 val pr_with_global_universes : Level.t -> Pp.std_ppcmds
 
 (** Local universe name <-> level mapping *)
@@ -95,11 +88,11 @@ val leq_constr_univs_infer : UGraph.t -> 'a constraint_accumulator ->
 
 (** [eq_constr_universes a b] [true, c] if [a] equals [b] modulo alpha, casts,
     application grouping and the universe constraints in [c]. *)
-val eq_constr_universes : constr -> constr -> bool universe_constrained
+val eq_constr_universes : constr -> constr -> universe_constraints option
 
 (** [leq_constr_universes a b] [true, c] if [a] is convertible to [b] modulo
     alpha, casts, application grouping and the universe constraints in [c]. *)
-val leq_constr_universes : constr -> constr -> bool universe_constrained
+val leq_constr_universes : constr -> constr -> universe_constraints option
 
 (** [eq_constr_universes a b] [true, c] if [a] equals [b] modulo alpha, casts,
     application grouping and the universe constraints in [c]. *)
@@ -232,40 +225,6 @@ val refresh_constraints : UGraph.t -> universe_context_set -> universe_context_s
 
 val pr_universe_opt_subst : universe_opt_subst -> Pp.std_ppcmds
 
-(* For tracing *)
-
-type constraints_map = (Univ.constraint_type * Univ.LMap.key) list Univ.LMap.t
-
-val pr_constraints_map : constraints_map -> Pp.std_ppcmds
-
-val choose_canonical : universe_set -> (Level.t -> bool) (* flexibles *) -> universe_set -> universe_set -> 
-  universe_level * (universe_set * universe_set * universe_set)
-    
-val compute_lbound : (constraint_type * Univ.universe) list -> universe option
-
-val instantiate_with_lbound : 
-  Univ.LMap.key ->
-  Univ.universe ->
-  bool ->
-  bool ->
-  Univ.LSet.t * Univ.universe option Univ.LMap.t *
-    Univ.LSet.t *
-    (bool * bool * Univ.universe) Univ.LMap.t * Univ.constraints ->
-  (Univ.LSet.t * Univ.universe option Univ.LMap.t *
-    Univ.LSet.t *
-     (bool * bool * Univ.universe) Univ.LMap.t * Univ.constraints) *
-    (bool * bool * Univ.universe)
-
-val minimize_univ_variables : 
-           Univ.LSet.t ->
-           Univ.universe option Univ.LMap.t ->
-           Univ.LSet.t ->
-  constraints_map -> constraints_map ->
-           Univ.constraints ->
-           Univ.LSet.t * Univ.universe option Univ.LMap.t *
-	     Univ.LSet.t *
-           (bool * bool * Univ.universe) Univ.LMap.t * Univ.constraints
-
 (** {6 Support for old-style sort-polymorphism } *)
 
 val solve_constraints_system : universe option array -> universe array -> universe array ->
diff --git a/grammar/argextend.mlp b/grammar/argextend.mlp
index eaaa7f025..d0ab5d803 100644
--- a/grammar/argextend.mlp
+++ b/grammar/argextend.mlp
@@ -180,8 +180,8 @@ let declare_vernac_argument loc s pr cl =
     <:str_item< do {
       Pptactic.declare_extra_genarg_pprule $wit$
         $pr_rules$
-        (fun _ _ _ _ -> Errors.anomaly (Pp.str "vernac argument needs not globwit printer"))
-        (fun _ _ _ _ -> Errors.anomaly (Pp.str "vernac argument needs not wit printer")) }
+        (fun _ _ _ _ -> CErrors.anomaly (Pp.str "vernac argument needs not globwit printer"))
+        (fun _ _ _ _ -> CErrors.anomaly (Pp.str "vernac argument needs not wit printer")) }
       >> ]
 
 open Pcaml
diff --git a/tools/compat5.ml b/grammar/compat5.ml
index 33c1cd602..33c1cd602 100644
--- a/tools/compat5.ml
+++ b/grammar/compat5.ml
diff --git a/tools/compat5.mlp b/grammar/compat5.mlp
index 8473a1fb7..8473a1fb7 100644
--- a/tools/compat5.mlp
+++ b/grammar/compat5.mlp
diff --git a/tools/compat5b.mlp b/grammar/compat5b.mlp
index 46802a825..46802a825 100644
--- a/tools/compat5b.mlp
+++ b/grammar/compat5b.mlp
diff --git a/grammar/grammar.mllib b/grammar/grammar.mllib
deleted file mode 100644
index 6c3ce7f03..000000000
--- a/grammar/grammar.mllib
+++ /dev/null
@@ -1,5 +0,0 @@
-GramCompat
-Q_util
-Argextend
-Tacextend
-Vernacextend
diff --git a/grammar/q_constr.mlp b/grammar/q_constr.mlp
deleted file mode 100644
index 8e1587ec3..000000000
--- a/grammar/q_constr.mlp
+++ /dev/null
@@ -1,112 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-open Q_util
-open GramCompat
-open Pcaml
-open PcamlSig (* necessary for camlp4 *)
-
-let loc = CompatLoc.ghost
-let dloc = <:expr< Loc.ghost >>
-
-let apply_ref f l =
-  <:expr<
-    Glob_term.GApp ($dloc$, Glob_term.GRef ($dloc$, Lazy.force $f$, None), $mlexpr_of_list (fun x -> x) l$)
-  >>
-
-EXTEND
-  GLOBAL: expr;
-  expr:
-    [ [ "PATTERN"; "["; c = constr; "]" ->
-      <:expr< snd (Patternops.pattern_of_glob_constr $c$) >> ] ]
-  ;
-  ident:
-    [ [ s = string -> <:expr< Names.Id.of_string $str:s$ >> ] ]
-  ;
-  name:
-    [ [ "_" -> <:expr< Anonymous >> | id = ident -> <:expr< Name $id$ >> ] ]
-  ;
-  string:
-    [ [ s = UIDENT -> s | s = LIDENT -> s ] ]
-  ;
-  constr:
-    [ "200" RIGHTA
-      [ LIDENT "forall"; id = ident; ":"; c1 = constr; ","; c2 = constr ->
-        <:expr< Glob_term.GProd ($dloc$,Name $id$,Decl_kinds.Explicit,$c1$,$c2$) >>
-      | "fun"; id = ident; ":"; c1 = constr; "=>"; c2 = constr ->
-        <:expr< Glob_term.GLambda ($dloc$,Name $id$,Decl_kinds.Explicit,$c1$,$c2$) >>
-      | "let"; id = ident; ":="; c1 = constr; "in"; c2 = constr ->
-        <:expr< Glob_term.RLetin ($dloc$,Name $id$,$c1$,$c2$) >>
-      (* fix todo *)
-      ]
-    | "100" RIGHTA
-      [ c1 = constr; ":"; c2 = SELF ->
-        <:expr< Glob_term.GCast($dloc$,$c1$,DEFAULTcast,$c2$) >> ]
-    | "90" RIGHTA
-      [ c1 = constr; "->"; c2 = SELF ->
-        <:expr< Glob_term.GProd ($dloc$,Anonymous,Decl_kinds.Explicit,$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< Glob_term.GApp ($dloc$,$f$,$args$) >> ]
-    | "0"
-      [ id = ident -> <:expr< Glob_term.GVar ($dloc$,$id$) >>
-      | "_" -> <:expr< Glob_term.GHole ($dloc$,Evar_kinds.QuestionMark (Evar_kinds.Define False),Misctypes.IntroAnonymous,None) >>
-      | "?"; id = ident -> <:expr< Glob_term.GPatVar($dloc$,(False,$id$)) >>
-      | "{"; c1 = constr; "}"; "+"; "{"; c2 = constr; "}" ->
-          apply_ref <:expr< coq_sumbool_ref >> [c1;c2]
-      | "%"; e = string -> <:expr< Glob_term.GRef ($dloc$,Lazy.force $lid:e$, None) >>
-      | 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< Glob_term.GCases ($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< Glob_term.PatCstr ($dloc$,$lid:e$,$lp$,Anonymous) >>
-      | p = patvar -> p
-      | "("; p = pattern; ")" -> p ] ]
-  ;
-  patvar:
-    [ [ "_" -> [], <:expr< Glob_term.PatVar ($dloc$,Anonymous) >>
-      | id = ident -> [id], <:expr< Glob_term.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/grammar/q_util.mlp b/grammar/q_util.mlp
index 2d5c40894..919ca3ad7 100644
--- a/grammar/q_util.mlp
+++ b/grammar/q_util.mlp
@@ -70,8 +70,8 @@ let rec mlexpr_of_prod_entry_key f = function
   | Uentryl (e, l) ->
     (** Keep in sync with Pcoq! *)
     assert (e = "tactic");
-    if l = 5 then <:expr< Extend.Aentry (Pcoq.Tactic.binder_tactic) >>
-    else <:expr< Extend.Aentryl (Pcoq.Tactic.tactic_expr) $mlexpr_of_int l$ >>
+    if l = 5 then <:expr< Extend.Aentry (Pltac.binder_tactic) >>
+    else <:expr< Extend.Aentryl (Pltac.tactic_expr) $mlexpr_of_int l$ >>
 
 let rec type_of_user_symbol = function
 | Ulist1 s | Ulist1sep (s, _) | Ulist0 s | Ulist0sep (s, _) ->
diff --git a/grammar/tacextend.mlp b/grammar/tacextend.mlp
index ac6a7ac7f..fe864ed40 100644
--- a/grammar/tacextend.mlp
+++ b/grammar/tacextend.mlp
@@ -48,7 +48,7 @@ let make_fun_clauses loc s l =
   let map c = GramCompat.make_fun loc [make_clause c] in
   mlexpr_of_list map l
 
-let get_argt e = <:expr< match $e$ with [ Genarg.ExtraArg tag -> tag | _ -> assert False ] >>
+let get_argt e = <:expr< (fun e -> match e with [ Genarg.ExtraArg tag -> tag | _ -> assert False ]) $e$ >>
 
 let rec mlexpr_of_symbol = function
 | Ulist1 s -> <:expr< Extend.Ulist1 $mlexpr_of_symbol s$ >>
@@ -61,7 +61,7 @@ let rec mlexpr_of_symbol = function
   <:expr< Extend.Uentry (Genarg.ArgT.Any $arg$) >>
 | Uentryl (e, l) ->
   assert (e = "tactic");
-  let arg = get_argt <:expr< Constrarg.wit_tactic >> in
+  let arg = get_argt <:expr< Tacarg.wit_tactic >> in
   <:expr< Extend.Uentryl (Genarg.ArgT.Any $arg$) $mlexpr_of_int l$>>
 
 let make_prod_item = function
@@ -111,14 +111,8 @@ let declare_tactic loc s c cl = match cl with
   declare_str_items loc
     [ <:str_item< do {
       let obj () = Tacenv.register_ltac True False $name$ $body$ in
-      try do {
-        Tacenv.register_ml_tactic $se$ [|$tac$|];
-        Mltop.declare_cache_obj obj $plugin_name$; }
-      with [ e when Errors.noncritical e ->
-        Feedback.msg_warning
-          (Pp.app
-            (Pp.str ("Exception in tactic extend " ^ $entry$ ^": "))
-            (Errors.print e)) ]; } >>
+      let () = Tacenv.register_ml_tactic $se$ [|$tac$|] in
+      Mltop.declare_cache_obj obj $plugin_name$ } >>
     ]
 | _ ->
   (** Otherwise we add parsing and printing rules to generate a call to a
@@ -129,14 +123,8 @@ let declare_tactic loc s c cl = match cl with
   let obj = <:expr< fun () -> Tacentries.add_ml_tactic_notation $se$ $gl$ >> in
   declare_str_items loc
     [ <:str_item< do {
-      try do {
         Tacenv.register_ml_tactic $se$ (Array.of_list $make_fun_clauses loc s cl$);
-        Mltop.declare_cache_obj $obj$ $plugin_name$; }
-      with [ e when Errors.noncritical e ->
-        Feedback.msg_warning
-          (Pp.app
-            (Pp.str ("Exception in tactic extend " ^ $entry$ ^": "))
-            (Errors.print e)) ]; } >>
+        Mltop.declare_cache_obj $obj$ $plugin_name$; } >>
     ]
 
 open Pcaml
diff --git a/grammar/vernacextend.mlp b/grammar/vernacextend.mlp
index ce0431889..04b117fba 100644
--- a/grammar/vernacextend.mlp
+++ b/grammar/vernacextend.mlp
@@ -122,14 +122,8 @@ let declare_command loc s c nt cl =
   let classl = make_fun_classifiers loc s c cl in
   declare_str_items loc
     [ <:str_item< do {
-	try do {
-          CList.iteri (fun i (depr, f) -> Vernacinterp.vinterp_add depr ($se$, i) f) $funcl$;
-          CList.iteri (fun i f -> Vernac_classifier.declare_vernac_classifier ($se$, i) f) $classl$ }
-	with [ e when Errors.noncritical e ->
-	  Feedback.msg_warning
-	    (Pp.app
-	       (Pp.str ("Exception in vernac extend " ^ $se$ ^": "))
-	       (Errors.print e)) ];
+        CList.iteri (fun i (depr, f) -> Vernacinterp.vinterp_add depr ($se$, i) f) $funcl$;
+        CList.iteri (fun i f -> Vernac_classifier.declare_vernac_classifier ($se$, i) f) $classl$;
 	CList.iteri (fun i r -> Egramml.extend_vernac_command_grammar ($se$, i) $nt$ r) $gl$;
       } >> ]
 
diff --git a/ide/.merlin b/ide/.merlin
index 3f3d9d275..953b5dce4 100644
--- a/ide/.merlin
+++ b/ide/.merlin
@@ -1,4 +1,4 @@
-PKG lablgtk2.sourceview2
+PKG unix laglgtk2 lablgtk2.sourceview2
 
 S utils
 B utils
diff --git a/ide/coq.ml b/ide/coq.ml
index 7a32faffc..6d44ca59e 100644
--- a/ide/coq.ml
+++ b/ide/coq.ml
@@ -227,7 +227,7 @@ type coqtop = {
   (* non quoted command-line arguments of coqtop *)
   mutable sup_args : string list;
   (* called whenever coqtop dies *)
-  mutable reset_handler : reset_kind -> unit task;
+  mutable reset_handler : unit task;
   (* called whenever coqtop sends a feedback message *)
   mutable feedback_handler : Feedback.feedback -> unit;
   (* actual coqtop process and its status *)
@@ -290,23 +290,20 @@ let rec check_errors = function
 | `NVAL :: _ -> raise (TubeError "NVAL")
 | `OUT :: _ -> raise (TubeError "OUT")
 
-let handle_intermediate_message handle xml =
-  let message = Feedback.to_message xml in
-  let level = message.Feedback.message_level in
-  let content = message.Feedback.message_content in
-  let logger = match handle.waiting_for with
-    | Some (_, l) -> l 
+let handle_intermediate_message handle level content =
+  let logger  = match handle.waiting_for with
+    | Some (_, l) -> l
     | None -> function
         | Feedback.Error   -> fun s -> Minilib.log ~level:`ERROR   (xml_to_string s)
         | Feedback.Info    -> fun s -> Minilib.log ~level:`INFO    (xml_to_string s)
         | Feedback.Notice  -> fun s -> Minilib.log ~level:`NOTICE  (xml_to_string s)
         | Feedback.Warning -> fun s -> Minilib.log ~level:`WARNING (xml_to_string s)
-        | Feedback.Debug _ -> fun s -> Minilib.log ~level:`DEBUG   (xml_to_string s)
+        | Feedback.Debug   -> fun s -> Minilib.log ~level:`DEBUG   (xml_to_string s)
   in
-  logger level (Richpp.richpp_of_xml content)
+  logger level content
 
 let handle_feedback feedback_processor xml =
-  let feedback = Feedback.to_feedback xml in
+  let feedback = Xmlprotocol.to_feedback xml in
   feedback_processor feedback
 
 let handle_final_answer handle xml =
@@ -335,15 +332,18 @@ let unsafe_handle_input handle feedback_processor state conds ~read_all =
     let l_end = Lexing.lexeme_end lex in
     state.fragment <- String.sub s l_end (String.length s - l_end);
     state.lexerror <- None;
-    if Feedback.is_message xml then begin
-      handle_intermediate_message handle xml;
+    match Xmlprotocol.is_message xml with
+    | Some (lvl, _loc, msg) ->
+      handle_intermediate_message handle lvl msg;
       loop ()
-    end else if Feedback.is_feedback xml then begin
-      handle_feedback feedback_processor xml;
-      loop ()
-    end else begin
-      ignore (handle_final_answer handle xml)
-    end
+    | None ->
+      if Xmlprotocol.is_feedback xml then begin
+        handle_feedback feedback_processor xml;
+        loop ()
+      end else
+        begin
+          ignore (handle_final_answer handle xml)
+        end
   in
   try loop ()
   with Xml_parser.Error _ as e ->
@@ -357,7 +357,9 @@ let unsafe_handle_input handle feedback_processor state conds ~read_all =
 
 let print_exception = function
   | Xml_parser.Error e -> Xml_parser.error e
-  | Serialize.Marshal_error -> "Protocol violation"
+  | Serialize.Marshal_error(expected,actual) ->
+      "Protocol violation. Expected: " ^ expected ^ " Actual: "
+        ^ Xml_printer.to_string actual
   | e -> Printexc.to_string e
 
 let input_watch handle respawner feedback_processor =
@@ -419,6 +421,7 @@ let mkready coqtop =
   fun () -> coqtop.status <- Ready; Void
 
 let rec respawn_coqtop ?(why=Unexpected) coqtop =
+  if why = Unexpected then warning "Coqtop died badly. Resetting.";
   clear_handle coqtop.handle;
   ignore_error (fun () ->
      coqtop.handle <-
@@ -430,7 +433,7 @@ let rec respawn_coqtop ?(why=Unexpected) coqtop =
      If not, there isn't much we can do ... *)
   assert (coqtop.handle.alive = true);
   coqtop.status <- New;
-  ignore (coqtop.reset_handler why coqtop.handle (mkready coqtop))
+  ignore (coqtop.reset_handler coqtop.handle (mkready coqtop))
 
 let spawn_coqtop sup_args =
   bind_self_as (fun this -> {
@@ -438,7 +441,7 @@ let spawn_coqtop sup_args =
                (fun () -> respawn_coqtop (this ()))
                (fun msg -> (this ()).feedback_handler msg);
     sup_args = sup_args;
-    reset_handler = (fun _ _ k -> k ());
+    reset_handler = (fun _ k -> k ());
     feedback_handler = (fun _ -> ());
     status = New;
   })
diff --git a/ide/coq.mli b/ide/coq.mli
index 7cef6a4d0..8a1fa3ed1 100644
--- a/ide/coq.mli
+++ b/ide/coq.mli
@@ -60,7 +60,7 @@ val is_computing : coqtop -> bool
 val spawn_coqtop : string list -> coqtop
 (** Create a coqtop process with some command-line arguments. *)
 
-val set_reset_handler : coqtop -> (reset_kind -> unit task) -> unit
+val set_reset_handler : coqtop -> unit task -> unit
 (** Register a handler called when a coqtop dies (badly or on purpose) *)
 
 val set_feedback_handler : coqtop -> (Feedback.feedback -> unit) -> unit
diff --git a/ide/coqOps.ml b/ide/coqOps.ml
index 930135995..1563c7ffb 100644
--- a/ide/coqOps.ml
+++ b/ide/coqOps.ml
@@ -14,15 +14,17 @@ open Feedback
 
 let b2c = byte_offset_to_char_offset
 
-type flag = [ `INCOMPLETE | `UNSAFE | `PROCESSING | `ERROR of Loc.t * string ]
-type mem_flag = [ `INCOMPLETE | `UNSAFE | `PROCESSING | `ERROR ]
+type flag = [ `INCOMPLETE | `UNSAFE | `PROCESSING | `ERROR of Loc.t * string | `WARNING of Loc.t * string ]
+type mem_flag = [ `INCOMPLETE | `UNSAFE | `PROCESSING | `ERROR | `WARNING ]
 let mem_flag_of_flag : flag -> mem_flag = function
   | `ERROR _ -> `ERROR
+  | `WARNING _ -> `WARNING
   | (`INCOMPLETE | `UNSAFE | `PROCESSING) as mem_flag -> mem_flag
 let str_of_flag = function
   | `UNSAFE -> "U"
   | `PROCESSING -> "P"
   | `ERROR _ -> "E"
+  | `WARNING _ -> "W"
   | `INCOMPLETE -> "I"
 
 class type signals =
@@ -136,7 +138,7 @@ object
   method tactic_wizard : string list -> unit task
   method process_next_phrase : unit task
   method process_until_end_or_error : unit task
-  method handle_reset_initial : Coq.reset_kind -> unit task
+  method handle_reset_initial : unit task
   method raw_coq_query : string -> unit task
   method show_goals : unit task
   method backtrack_last_phrase : unit task
@@ -337,8 +339,11 @@ object(self)
   method private show_goals_aux ?(move_insert=false) () =
     Coq.PrintOpt.set_printing_width proof#width;
     if move_insert then begin
-      buffer#place_cursor ~where:self#get_start_of_input;
-      script#recenter_insert;
+      let dest = self#get_start_of_input in
+      if (buffer#get_iter_at_mark `INSERT)#compare dest <= 0 then begin
+        buffer#place_cursor ~where:dest;
+        script#recenter_insert
+      end
     end;
     Coq.bind (Coq.goals ~logger:messages#push ()) (function
     | Fail x -> self#handle_failure_aux ~move_insert x
@@ -442,7 +447,6 @@ object(self)
       | Processed, Some (id,sentence) ->
           log "Processed" id;
           remove_flag sentence `PROCESSING;
-          remove_flag sentence `ERROR;
           self#mark_as_needed sentence
       | ProcessingIn _,  Some (id,sentence) ->
           log "ProcessingIn" id;
@@ -460,7 +464,9 @@ object(self)
           log "GlobRef" id;
           self#attach_tooltip sentence loc
             (Printf.sprintf "%s %s %s" filepath ident ty)
-      | ErrorMsg(loc, msg), Some (id,sentence) ->
+      | Message(Error, loc, msg), Some (id,sentence) ->
+          let loc = Option.default Loc.ghost loc in
+          let msg = Richpp.raw_print msg         in
           log "ErrorMsg" id;
           remove_flag sentence `PROCESSING;
           add_flag sentence (`ERROR (loc, msg));
@@ -468,6 +474,15 @@ object(self)
           self#attach_tooltip sentence loc msg;
           if not (Loc.is_ghost loc) then
             self#position_error_tag_at_sentence sentence (Some (Loc.unloc loc))
+      | Message(Warning, loc, msg), Some (id,sentence) ->
+          let loc = Option.default Loc.ghost loc in
+          let msg = Richpp.raw_print msg         in
+          log "WarningMsg" id;
+          add_flag sentence (`WARNING (loc, msg));
+          self#attach_tooltip sentence loc msg;
+          self#position_warning_tag_at_sentence sentence loc
+      | Message((Info|Notice|Debug as lvl), _, msg), _ ->
+          messages#push lvl msg
       | InProgress n, _ ->
           if n < 0 then processed <- processed + abs n
           else to_process <- to_process + n
@@ -509,6 +524,18 @@ object(self)
     let start, _, phrase = self#get_sentence sentence in
     self#position_error_tag_at_iter start phrase loc
 
+  method private position_warning_tag_at_iter iter_start iter_stop phrase loc =
+    if Loc.is_ghost loc then
+        buffer#apply_tag Tags.Script.warning ~start:iter_start ~stop:iter_stop
+    else
+      buffer#apply_tag Tags.Script.warning
+	  ~start:(iter_start#forward_chars (b2c phrase loc.Loc.bp))
+          ~stop:(iter_stop#forward_chars (b2c phrase loc.Loc.ep))
+
+  method private position_warning_tag_at_sentence sentence loc =
+    let start, stop, phrase = self#get_sentence sentence in
+    self#position_warning_tag_at_iter start stop phrase loc
+
   method private process_interp_error queue sentence loc msg tip id =
     Coq.bind (Coq.return ()) (function () ->
     let start, stop, phrase = self#get_sentence sentence in
@@ -535,13 +562,19 @@ object(self)
       condition returns true; it is fed with the number of phrases read and the
       iters enclosing the current sentence. *)
   method private fill_command_queue until queue =
+    let topstack =
+      if Doc.focused document then fst (Doc.context document) else [] in
     let rec loop n iter =
       match Sentence.find buffer iter with
       | None -> ()
       | Some (start, stop) ->
         if until n start stop then begin
           ()
-        end else if stop#backward_char#has_tag Tags.Script.processed then begin
+        end else if
+          List.exists (fun (_, s) ->
+            start#equal (buffer#get_iter_at_mark s.start) &&
+            stop#equal (buffer#get_iter_at_mark s.stop)) topstack
+        then begin
           Queue.push (`Skip (start, stop)) queue;
           loop n stop
         end else begin
@@ -741,7 +774,7 @@ object(self)
           self#cleanup (Doc.cut_at document to_id);
           conclusion ()
       | Fail (safe_id, loc, msg) ->
-          if loc <> None then messages#push Feedback.Error (Richpp.richpp_of_string "Fixme LOC");
+(*           if loc <> None then messages#push Feedback.Error (Richpp.richpp_of_string "Fixme LOC"); *)
           messages#push Feedback.Error msg;
           if Stateid.equal safe_id Stateid.dummy then self#show_goals
           else undo safe_id
@@ -759,7 +792,6 @@ object(self)
   method private handle_failure_aux
     ?(move_insert=false) (safe_id, (loc : (int * int) option), msg)
   =
-    messages#clear;
     messages#push Feedback.Error msg;
     ignore(self#process_feedback ());
     if Stateid.equal safe_id Stateid.dummy then Coq.lift (fun () -> ())
@@ -842,10 +874,8 @@ object(self)
     in
     loop l
 
-  method handle_reset_initial why =
+  method handle_reset_initial =
     let action () =
-      if why = Coq.Unexpected then warning "Coqtop died badly. Resetting."
-      else
       (* clear the stack *)
       if Doc.focused document then Doc.unfocus document;
       while not (Doc.is_empty document) do
diff --git a/ide/coqOps.mli b/ide/coqOps.mli
index 4a37a1fa5..332c18f2f 100644
--- a/ide/coqOps.mli
+++ b/ide/coqOps.mli
@@ -15,7 +15,7 @@ object
   method tactic_wizard : string list -> unit task
   method process_next_phrase : unit task
   method process_until_end_or_error : unit task
-  method handle_reset_initial : Coq.reset_kind -> unit task
+  method handle_reset_initial : unit task
   method raw_coq_query : string -> unit task
   method show_goals : unit task
   method backtrack_last_phrase : unit task
diff --git a/ide/coqide.ml b/ide/coqide.ml
index 758a5a4c9..450bfcdfb 100644
--- a/ide/coqide.ml
+++ b/ide/coqide.ml
@@ -677,12 +677,18 @@ let searchabout sn =
 
 let searchabout () = on_current_term searchabout
 
+let doquery query sn =
+  sn.messages#clear;
+  Coq.try_grab sn.coqtop (sn.coqops#raw_coq_query query) ignore
+
 let otherquery command sn =
-  let word = get_current_word sn in
-  if word <> "" then
-    let query = command ^ " " ^ word ^ "." in
-    sn.messages#clear;
-    Coq.try_grab sn.coqtop (sn.coqops#raw_coq_query query) ignore
+  Option.iter (fun query -> doquery (query ^ ".") sn)
+    begin try
+      let i = CString.string_index_from command 0 "..." in
+      let word = get_current_word sn in
+      if word = "" then None
+      else Some (CString.sub command 0 i ^ " " ^ word)
+    with Not_found -> Some command end
 
 let otherquery command = cb_on_current_term (otherquery command)
 
@@ -859,12 +865,12 @@ let toggle_items menu_name l =
   in
   List.iter f l
 
+let no_under = Util.String.map (fun x -> if x = '_' then '-' else x)
+
 (** Create alphabetical menu items with elements in sub-items.
     [l] is a list of lists, one per initial letter *)
 
 let alpha_items menu_name item_name l =
-  let no_under = Util.String.map (fun x -> if x = '_' then '-' else x)
-  in
   let mk_item text =
     let text' =
       let last = String.length text - 1 in
@@ -911,6 +917,16 @@ let template_item (text, offset, len, key) =
   in
   item name ~label ~callback:(cb_on_current_term callback) ~accel:(modifier^key)
 
+(** Create menu items for pairs (query, shortcut key). *)
+let user_queries_items menu_name item_name l =
+  let mk_item (query, key) =
+    let callback = Query.query query in
+    let accel = if not (CString.is_empty key) then
+      Some (modifier_for_queries#get^key) else None in
+    item (item_name^" "^(no_under query)) ~label:query ?accel ~callback menu_name
+  in
+  List.iter mk_item l
+
 let emit_to_focus window sgn =
   let focussed_widget = GtkWindow.Window.get_focus window#as_window in
   let obj = Gobject.unsafe_cast focussed_widget in
@@ -921,7 +937,6 @@ let emit_to_focus window sgn =
 let build_ui () =
   let w = GWindow.window
     ~wm_class:"CoqIde" ~wm_name:"CoqIde"
-    ~allow_grow:true ~allow_shrink:true
     ~width:window_width#get ~height:window_height#get
     ~title:"CoqIde" ()
   in
@@ -1100,16 +1115,22 @@ let build_ui () =
   ];
   alpha_items templates_menu "Template" Coq_commands.commands;
 
-  let qitem s accel = item s ~label:("_"^s) ?accel ~callback:(Query.query s) in
+  let qitem s sc ?(dots = true) =
+    let query = if dots then s ^ "..." else s in
+    item s ~label:("_"^s)
+      ~accel:(modifier_for_queries#get^sc)
+      ~callback:(Query.query query)
+  in
   menu queries_menu [
     item "Queries" ~label:"_Queries";
-    qitem "Search" (Some "<Ctrl><Shift>K");
-    qitem "Check" (Some "<Ctrl><Shift>C");
-    qitem "Print" (Some "<Ctrl><Shift>P");
-    qitem "About" (Some "<Ctrl><Shift>A");
-    qitem "Locate" (Some "<Ctrl><Shift>L");
-    qitem "Print Assumptions" (Some "<Ctrl><Shift>N");
+    qitem "Search" "K" ~dots:false;
+    qitem "Check" "C";
+    qitem "Print" "P";
+    qitem "About" "A";
+    qitem "Locate" "L";
+    qitem "Print Assumptions" "N";
   ];
+  user_queries_items queries_menu "User-Query" user_queries#get;
 
   menu tools_menu [
     item "Tools" ~label:"_Tools";
diff --git a/ide/coqide_ui.ml b/ide/coqide_ui.ml
index edfe28b26..2ae18593a 100644
--- a/ide/coqide_ui.ml
+++ b/ide/coqide_ui.ml
@@ -18,6 +18,15 @@ let list_items menu li =
   let () = List.iter (fun b -> Buffer.add_buffer res_buf (tactic_item b)) li in
   res_buf
 
+let list_queries menu li =
+  let res_buf = Buffer.create 500 in
+  let query_item (q, _) =
+    let s = "<menuitem action='"^menu^" "^(no_under q)^"' />\n" in
+    Buffer.add_string res_buf s
+  in
+  let () = List.iter query_item li in
+  res_buf
+
 let init () =
   let theui = Printf.sprintf "<ui>
 <menubar name='CoqIde MenuBar'>
@@ -119,6 +128,8 @@ let init () =
     <menuitem action='About' />
     <menuitem action='Locate' />
     <menuitem action='Print Assumptions' />
+    <separator />
+    %s
   </menu>
   <menu name='Tools' action='Tools'>
     <menuitem action='Comment' />
@@ -162,5 +173,6 @@ let init () =
     (if Coq_config.gtk_platform <> `QUARTZ then "<menuitem action='Quit' />" else "")
     (Buffer.contents (list_items "Tactic" Coq_commands.tactics))
     (Buffer.contents (list_items "Template" Coq_commands.commands))
+    (Buffer.contents (list_queries "User-Query" Preferences.user_queries#get))
  in
   ignore (ui_m#add_ui_from_string theui);
diff --git a/ide/coqidetop.mllib b/ide/coqidetop.mllib
index 92301dc30..ed1fa465d 100644
--- a/ide/coqidetop.mllib
+++ b/ide/coqidetop.mllib
@@ -1,2 +1,9 @@
+Xml_lexer
+Xml_parser
+Xml_printer
+Serialize
+Richprinter
 Xmlprotocol
+Texmacspp
+Document
 Ide_slave
diff --git a/ide/ide.mllib b/ide/ide.mllib
index 83b314283..72a14134b 100644
--- a/ide/ide.mllib
+++ b/ide/ide.mllib
@@ -1,12 +1,7 @@
 Minilib
-Okey
-Config_file
-Configwin_keys
-Configwin_types
 Configwin_messages
 Configwin_ihm
 Configwin
-Editable_cells
 Config_parser
 Tags
 Wg_Notebook
@@ -14,8 +9,13 @@ Config_lexer
 Utf8_convert
 Preferences
 Project_file
-Ideutils
+Serialize
+Richprinter
+Xml_lexer
+Xml_parser
+Xml_printer
 Xmlprotocol
+Ideutils
 Coq
 Coq_lex
 Sentence
diff --git a/ide/ide_slave.ml b/ide/ide_slave.ml
index 59efc2d82..ae3dcd94a 100644
--- a/ide/ide_slave.ml
+++ b/ide/ide_slave.ml
@@ -1,4 +1,5 @@
 (************************************************************************)
+
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
 (* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
 (*   \VV/  **************************************************************)
@@ -7,11 +8,15 @@
 (************************************************************************)
 
 open Vernacexpr
-open Errors
+open CErrors
 open Util
 open Pp
 open Printer
 
+module RelDecl = Context.Rel.Declaration
+module NamedDecl = Context.Named.Declaration
+module CompactedDecl = Context.Compacted.Declaration
+
 (** Ide_slave : an implementation of [Interface], i.e. mainly an interp
     function and a rewind function. This specialized loop is triggered
     when the -ideslave option is passed to Coqtop. Currently CoqIDE is
@@ -47,6 +52,7 @@ let init_stdout, read_stdout =
 
 let pr_with_pid s = Printf.eprintf "[pid %d] %s\n%!" (Unix.getpid ()) s
 
+let pr_error s = pr_with_pid s
 let pr_debug s =
   if !Flags.debug then pr_with_pid s
 let pr_debug_call q =
@@ -94,11 +100,11 @@ let is_undo cmd = match cmd with
 (** Check whether a command is forbidden by CoqIDE *)
 
 let coqide_cmd_checks (loc,ast) =
-  let user_error s = Errors.user_err_loc (loc, "CoqIde", str s) in
+  let user_error s = CErrors.user_err ~loc ~hdr:"CoqIde" (str s) in
   if is_debug ast then
     user_error "Debug mode not available within CoqIDE";
   if is_known_option ast then
-    Feedback.msg_warning (strbrk"This will not work. Use CoqIDE display menu instead");
+    Feedback.msg_warning (strbrk"This will not work. Use CoqIDE view menu instead");
   if Vernac.is_navigation_vernac ast || is_undo ast then
     Feedback.msg_warning (strbrk "Rather use CoqIDE navigation instead");
   if is_query ast then
@@ -131,7 +137,8 @@ let annotate phrase =
 (** Goal display *)
 
 let hyp_next_tac sigma env decl =
-  let (id,_,ast) = Context.Named.Declaration.to_tuple decl in
+  let id = NamedDecl.get_id decl in
+  let ast = NamedDecl.get_type decl in
   let id_s = Names.Id.to_string id in
   let type_s = string_of_ppcmds (pr_ltype_env env sigma ast) in
   [
@@ -188,16 +195,12 @@ let process_goal sigma g =
     Richpp.richpp_of_pp (pr_goal_concl_style_env env sigma norm_constr)
   in
   let process_hyp d (env,l) =
-    let d = Context.NamedList.Declaration.map_constr (Reductionops.nf_evar sigma) d in
-    let d' = List.map (fun name -> let open Context.Named.Declaration in
-                                   match pi2 d with
-                                   | None -> LocalAssum (name, pi3 d)
-                                   | Some value -> LocalDef (name, value, pi3 d))
-                      (pi1 d) in
+    let d = CompactedDecl.map_constr (Reductionops.nf_evar sigma) d in
+    let d' = CompactedDecl.to_named_context d in
       (List.fold_right Environ.push_named d' env,
-       (Richpp.richpp_of_pp (pr_var_list_decl env sigma d)) :: l) in
+       (Richpp.richpp_of_pp (pr_compacted_decl env sigma d)) :: l) in
   let (_env, hyps) =
-    Context.NamedList.fold process_hyp
+    Context.Compacted.fold process_hyp
       (Termops.compact_named_context (Environ.named_context env)) ~init:(min_env,[]) in
   { Interface.goal_hyp = List.rev hyps; Interface.goal_ccl = ccl; Interface.goal_id = id; }
 
@@ -281,11 +284,33 @@ let export_coq_object t = {
   Interface.coq_object_object = t.Search.coq_object_object
 }
 
+let pattern_of_string ?env s =
+  let env =
+    match env with
+    | None -> Global.env ()
+    | Some e -> e
+  in
+  let constr = Pcoq.parse_string Pcoq.Constr.lconstr_pattern s in
+  let (_, pat) = Constrintern.intern_constr_pattern env constr in
+  pat
+
+let dirpath_of_string_list s =
+  let path = String.concat "." s in
+  let m = Pcoq.parse_string Pcoq.Constr.global path in
+  let (_, qid) = Libnames.qualid_of_reference m in
+  let id =
+    try Nametab.full_name_module qid
+    with Not_found ->
+      CErrors.user_err ~hdr:"Search.interface_search"
+        (str "Module " ++ str path ++ str " not found.")
+  in
+  id
+
 let import_search_constraint = function
-  | Interface.Name_Pattern s    -> Search.Name_Pattern s
-  | Interface.Type_Pattern s    -> Search.Type_Pattern s
-  | Interface.SubType_Pattern s -> Search.SubType_Pattern s
-  | Interface.In_Module ms      -> Search.In_Module ms
+  | Interface.Name_Pattern s    -> Search.Name_Pattern (Str.regexp s)
+  | Interface.Type_Pattern s    -> Search.Type_Pattern (pattern_of_string s)
+  | Interface.SubType_Pattern s -> Search.SubType_Pattern (pattern_of_string s)
+  | Interface.In_Module ms      -> Search.In_Module (dirpath_of_string_list ms)
   | Interface.Include_Blacklist -> Search.Include_Blacklist
 
 let search flags =
@@ -341,12 +366,12 @@ let handle_exn (e, info) =
     | _ -> None in
   let mk_msg () =
     let msg = read_stdout () in
-    let msg = str msg ++ fnl () ++ Errors.print ~info e in
+    let msg = str msg ++ fnl () ++ CErrors.print ~info e in
     Richpp.richpp_of_pp msg
   in
   match e with
-  | Errors.Drop -> dummy, None, Richpp.richpp_of_string "Drop is not allowed by coqide!"
-  | Errors.Quit -> dummy, None, Richpp.richpp_of_string "Quit is not allowed by coqide!"
+  | CErrors.Drop -> dummy, None, Richpp.richpp_of_string "Drop is not allowed by coqide!"
+  | CErrors.Quit -> dummy, None, Richpp.richpp_of_string "Quit is not allowed by coqide!"
   | e ->
       match Stateid.get info with
       | Some (valid, _) -> valid, loc_of info, mk_msg ()
@@ -361,8 +386,6 @@ let init =
      match file with
      | None -> Stm.get_current_state ()
      | Some file ->
-         if not (Filename.check_suffix file ".v") then
-           error "A file with suffix .v is expected.";
          let dir = Filename.dirname file in
          let open Loadpath in let open CUnix in
          let initial_id, _ =
@@ -370,7 +393,8 @@ let init =
              Stm.add false ~ontop:(Stm.get_current_state ())
                0 (Printf.sprintf "Add LoadPath \"%s\". " dir)
            else Stm.get_current_state (), `NewTip in
-         Stm.set_compilation_hints file;
+         if Filename.check_suffix file ".v" then
+           Stm.set_compilation_hints file;
          Stm.finish ();
          initial_id
    end
@@ -393,6 +417,15 @@ let interp ((_raw, verbose), s) =
 
 let quit = ref false
 
+(** Serializes the output of Stm.get_ast  *)
+let print_ast id =
+  match Stm.get_ast id with
+  | Some (expr, loc) -> begin
+      try  Texmacspp.tmpp expr loc
+      with e -> Xml_datatype.PCData ("ERROR " ^ Printexc.to_string e)
+    end
+  | None     -> Xml_datatype.PCData "ERROR"
+
 (** Grouping all call handlers together + error handling *)
 
 let eval_call xml_oc log c =
@@ -423,7 +456,7 @@ let eval_call xml_oc log c =
     Interface.interp = interruptible interp;
     Interface.handle_exn = handle_exn;
     Interface.stop_worker = Stm.stop_worker;
-    Interface.print_ast = Stm.print_ast;
+    Interface.print_ast = print_ast;
     Interface.annotate = interruptible annotate;
   } in
   Xmlprotocol.abstract_eval_call handler c
@@ -438,22 +471,18 @@ let print_xml =
   fun oc xml ->
     Mutex.lock m;
     try Xml_printer.print oc xml; Mutex.unlock m
-    with e -> let e = Errors.push e in Mutex.unlock m; iraise e
+    with e -> let e = CErrors.push e in Mutex.unlock m; iraise e
 
 
-let slave_logger xml_oc level message =
+let slave_logger xml_oc ?loc level message =
   (* convert the message into XML *)
   let msg = hov 0 message in
-  let message = {
-    Feedback.message_level = level;
-    Feedback.message_content = (Richpp.repr (Richpp.richpp_of_pp msg));
-  } in
-  let () = pr_debug (Printf.sprintf "-> %S" (string_of_ppcmds msg)) in
-  let xml = Feedback.of_message message in
+  let () = pr_debug (Printf.sprintf "-> %S" (string_of_ppcmds msg))         in
+  let xml = Xmlprotocol.of_message level loc (Richpp.richpp_of_pp message) in
   print_xml xml_oc xml
 
 let slave_feeder xml_oc msg =
-  let xml = Feedback.of_feedback msg in
+  let xml = Xmlprotocol.of_feedback msg in
   print_xml xml_oc xml
 
 (** The main loop *)
@@ -472,7 +501,7 @@ let loop () =
   let xml_ic = Xml_parser.make (Xml_parser.SLexbuf in_lb) in
   let () = Xml_parser.check_eof xml_ic false in
   Feedback.set_logger (slave_logger xml_oc);
-  Feedback.set_feeder (slave_feeder xml_oc);
+  Feedback.add_feeder (slave_feeder xml_oc);
   (* We'll handle goal fetching and display in our own way *)
   Vernacentries.enable_goal_printing := false;
   Vernacentries.qed_display_script := false;
@@ -492,11 +521,11 @@ let loop () =
         pr_debug "End of input, exiting gracefully.";
         exit 0
       | Xml_parser.Error (err, loc) ->
-        pr_debug ("Syntax error in query: " ^ Xml_parser.error_msg err);
-        exit 1
-      | Serialize.Marshal_error ->
-        pr_debug "Incorrect query.";
-        exit 1
+        pr_error ("XML syntax error: " ^ Xml_parser.error_msg err)
+      | Serialize.Marshal_error (msg,node) ->
+        pr_error "Unexpected XML message";
+        pr_error ("Expected XML node: " ^ msg);
+        pr_error ("XML tree received: " ^ Xml_printer.to_string_fmt node)
       | any ->
         pr_debug ("Fatal exception in coqtop:\n" ^ Printexc.to_string any);
         exit 1
diff --git a/ide/ideutils.ml b/ide/ideutils.ml
index 00c3f88e5..06a132732 100644
--- a/ide/ideutils.ml
+++ b/ide/ideutils.ml
@@ -46,23 +46,37 @@ let xml_to_string xml =
   let () = iter (Richpp.repr xml) in
   Buffer.contents buf
 
-let translate s = s
-
-let insert_xml ?(tags = []) (buf : #GText.buffer_skel) msg =
+let insert_with_tags (buf : #GText.buffer_skel) mark rmark tags text =
+  (** FIXME: LablGTK2 does not export the C insert_with_tags function, so that
+      it has to reimplement its own helper function. Unluckily, it relies on
+      a slow algorithm, so that we have to have our own quicker version here.
+      Alas, it is still much slower than the native version... *)
+  if CList.is_empty tags then buf#insert ~iter:(buf#get_iter_at_mark mark) text
+  else
+    let it = buf#get_iter_at_mark mark in
+    let () = buf#move_mark rmark ~where:it in
+    let () = buf#insert ~iter:(buf#get_iter_at_mark mark) text in
+    let start = buf#get_iter_at_mark mark in
+    let stop = buf#get_iter_at_mark rmark in
+    let iter tag = buf#apply_tag tag start stop in
+    List.iter iter tags
+
+let insert_xml ?(mark = `INSERT) ?(tags = []) (buf : #GText.buffer_skel) msg =
   let open Xml_datatype in
   let tag name =
-    let name = translate name in
     match GtkText.TagTable.lookup buf#tag_table name with
     | None -> raise Not_found
     | Some tag -> new GText.tag tag
   in
+  let rmark = `MARK (buf#create_mark buf#start_iter) in
   let rec insert tags = function
-  | PCData s -> buf#insert ~tags:(List.rev tags) s
+  | PCData s -> insert_with_tags buf mark rmark tags s
   | Element (t, _, children) ->
     let tags = try tag t :: tags with Not_found -> tags in
     List.iter (fun xml -> insert tags xml) children
   in
-  insert tags (Richpp.repr msg)
+  let () = try insert tags (Richpp.repr msg) with _ -> () in
+  buf#delete_mark rmark
 
 let set_location = ref  (function s -> failwith "not ready")
 
@@ -112,6 +126,24 @@ let try_convert s =
     "(* Fatal error: wrong encoding in input. \
 Please choose a correct encoding in the preference panel.*)";;
 
+let export file_name s =
+  let oc = open_out_bin file_name in
+  let ending = line_ending#get in
+  let is_windows = ref false in
+  for i = 0 to String.length s - 1 do
+    match s.[i] with
+    | '\r' -> is_windows := true
+    | '\n' ->
+      begin match ending with
+      | `DEFAULT ->
+        if !is_windows then (output_char oc '\r'; output_char oc '\n')
+        else output_char oc '\n'
+      | `WINDOWS -> output_char oc '\r'; output_char oc '\n'
+      | `UNIX -> output_char oc '\n'
+      end
+    | c -> output_char oc c
+  done;
+  close_out oc
 
 let try_export file_name s =
   let s =
@@ -134,11 +166,7 @@ let try_export file_name s =
       Minilib.log ("Error ("^str^") in transcoding: falling back to UTF-8");
       s
   in
-  try
-    let oc = open_out file_name in
-    output_string oc s;
-    close_out oc;
-    true
+  try export file_name s; true
   with e -> Minilib.log (Printexc.to_string e);false
 
 type timer = { run : ms:int -> callback:(unit->bool) -> unit;
@@ -301,7 +329,7 @@ type logger = Feedback.level -> Richpp.richpp -> unit
 
 let default_logger level message =
   let level = match level with
-  | Feedback.Debug _ -> `DEBUG
+  | Feedback.Debug -> `DEBUG
   | Feedback.Info -> `INFO
   | Feedback.Notice -> `NOTICE
   | Feedback.Warning -> `WARNING
diff --git a/ide/ideutils.mli b/ide/ideutils.mli
index 491e8e823..e32a4d9e3 100644
--- a/ide/ideutils.mli
+++ b/ide/ideutils.mli
@@ -54,7 +54,7 @@ val flash_info : ?delay:int -> string -> unit
 
 val xml_to_string : Richpp.richpp -> string
 
-val insert_xml : ?tags:GText.tag list ->
+val insert_xml : ?mark:GText.mark -> ?tags:GText.tag list ->
   #GText.buffer_skel -> Richpp.richpp -> unit
 
 val set_location : (string -> unit) ref
diff --git a/ide/interface.mli b/ide/interface.mli
index 2a9b8b241..123cac6c2 100644
--- a/ide/interface.mli
+++ b/ide/interface.mli
@@ -139,7 +139,7 @@ type add_rty = state_id * ((unit, state_id) union * string)
     [Inr (start,(stop,tip))] if [id] is in a zone that can be focused.
     In that case the zone is delimited by [start] and [stop] while [tip]
     is the new document [tip].  Edits made by subsequent [add] are always
-    performend on top of [id]. *)
+    performed on top of [id]. *)
 type edit_at_sty = state_id
 type edit_at_rty = (unit, state_id * (state_id * state_id)) union
 
@@ -153,7 +153,7 @@ type query_rty = string
 type goals_sty = unit
 type goals_rty = goals option
 
-(** Retrieve the list of unintantiated evars in the current proof. [None] if no
+(** Retrieve the list of uninstantiated evars in the current proof. [None] if no
     proof is in progress. *)
 type evars_sty = unit
 type evars_rty = evar list option
diff --git a/ide/preferences.ml b/ide/preferences.ml
index c4dc55972..f0fd45d77 100644
--- a/ide/preferences.ml
+++ b/ide/preferences.ml
@@ -33,6 +33,7 @@ type obj = {
 }
 
 let preferences : obj Util.String.Map.t ref = ref Util.String.Map.empty
+let unknown_preferences : string list Util.String.Map.t ref = ref Util.String.Map.empty
 
 class type ['a] repr =
 object
@@ -121,6 +122,18 @@ let inputenc_of_string s =
        else if s = "LOCALE" then Elocale
        else Emanual s)
 
+type line_ending = [ `DEFAULT | `WINDOWS | `UNIX ]
+
+let line_end_of_string = function
+| "unix" -> `UNIX
+| "windows" -> `WINDOWS
+| _ -> `DEFAULT
+
+let line_end_to_string = function
+| `UNIX -> "unix"
+| `WINDOWS -> "windows"
+| `DEFAULT -> "default"
+
 let use_default_doc_url = "(automatic)"
 
 module Repr =
@@ -144,6 +157,18 @@ object
   method into s = Some s
 end
 
+let string_pair_list (sep : char) : (string * string) list repr =
+object
+  val sep' = String.make 1 sep
+  method from = CList.map (fun (s1, s2) -> CString.concat sep' [s1; s2])
+  method into l =
+    try
+      Some (CList.map (fun s ->
+        let split = CString.split sep s in
+        CList.nth split 0, CList.nth split 1) l)
+    with Failure _ -> None
+end
+
 let bool : bool repr =
 object
   method from s = [string_of_bool s]
@@ -303,10 +328,14 @@ let modifier_for_tactics =
 let modifier_for_display =
   new preference ~name:["modifier_for_display"] ~init:"<Alt><Shift>" ~repr:Repr.(string)
 
+let modifier_for_queries =
+  new preference ~name:["modifier_for_queries"] ~init:"<Control><Shift>" ~repr:Repr.(string)
+
 let _ = attach_modifiers modifier_for_navigation "<Actions>/Navigation/"
 let _ = attach_modifiers modifier_for_templates "<Actions>/Templates/"
 let _ = attach_modifiers modifier_for_tactics "<Actions>/Tactics/"
 let _ = attach_modifiers modifier_for_display "<Actions>/View/"
+let _ = attach_modifiers modifier_for_queries "<Actions>/Queries/"
 
 let modifiers_valid =
   new preference ~name:["modifiers_valid"] ~init:"<Alt><Control><Shift>" ~repr:Repr.(string)
@@ -365,6 +394,10 @@ let stop_before =
 let reset_on_tab_switch =
   new preference ~name:["reset_on_tab_switch"] ~init:false ~repr:Repr.(bool)
 
+let line_ending =
+  let repr = Repr.custom line_end_to_string line_end_of_string in
+  new preference ~name:["line_ending"] ~init:`DEFAULT ~repr
+
 let vertical_tabs =
   new preference ~name:["vertical_tabs"] ~init:false ~repr:Repr.(bool)
 
@@ -435,7 +468,7 @@ let create_tag name default =
   let iter table =
     let tag = GText.tag ~name () in
     table#add tag#as_tag;
-    pref#connect#changed (fun _ -> set_tag tag);
+    ignore (pref#connect#changed (fun _ -> set_tag tag));
     set_tag tag;
   in
   List.iter iter [Tags.Script.table; Tags.Proof.table; Tags.Message.table];
@@ -507,6 +540,9 @@ let highlight_current_line =
 let nanoPG =
   new preference ~name:["nanoPG"] ~init:false ~repr:Repr.(bool)
 
+let user_queries =
+  new preference ~name:["user_queries"] ~init:[] ~repr:Repr.(string_pair_list '$')
+
 class tag_button (box : Gtk.box Gtk.obj) =
 object (self)
 
@@ -582,19 +618,19 @@ let save_pref () =
   then Unix.mkdir (Minilib.coqide_config_home ()) 0o700;
   let () = try GtkData.AccelMap.save accel_file with _ -> () in
   let add = Util.String.Map.add in
-  let (++) x f = f x in
   let fold key obj accu = add key (obj.get ()) accu in
- 
-    (Util.String.Map.fold fold !preferences Util.String.Map.empty) ++
-    Config_lexer.print_file pref_file
+  let prefs = Util.String.Map.fold fold !preferences Util.String.Map.empty in
+  let prefs = Util.String.Map.fold Util.String.Map.add !unknown_preferences prefs in
+  Config_lexer.print_file pref_file prefs
 
 let load_pref () =
   let () = try GtkData.AccelMap.load loaded_accel_file with _ -> () in
 
     let m = Config_lexer.load_file loaded_pref_file in
     let iter name v =
-      try (Util.String.Map.find name !preferences).set v
-      with _ -> ()
+      if Util.String.Map.mem name !preferences then
+        try (Util.String.Map.find name !preferences).set v with _ -> ()
+      else unknown_preferences := Util.String.Map.add name v !unknown_preferences
     in
     Util.String.Map.iter iter m
 
@@ -799,6 +835,15 @@ let configure ?(apply=(fun () -> ())) () =
       (string_of_inputenc encoding#get)
   in
 
+  let line_ending =
+    combo
+      "EOL character"
+      ~f:(fun s -> line_ending#set (line_end_of_string s))
+      ~new_allowed:false
+      ["unix"; "windows"; "default"]
+      (line_end_to_string line_ending#get)
+  in
+
   let source_style =
     combo "Highlighting style:"
       ~f:source_style#set ~new_allowed:false
@@ -837,6 +882,9 @@ let configure ?(apply=(fun () -> ())) () =
   let modifier_for_display =
     pmodifiers "Modifiers for View Menu" modifier_for_display
   in
+  let modifier_for_queries =
+    pmodifiers "Modifiers for Queries Menu" modifier_for_queries
+  in
   let modifiers_valid =
     pmodifiers ~all:true "Allowed modifiers" modifiers_valid
   in
@@ -870,7 +918,7 @@ let configure ?(apply=(fun () -> ())) () =
   in
   let doc_url =
     let predefined = [
-      "file://"^(List.fold_left Filename.concat (Coq_config.docdir) ["html";"refman";""]);
+      "file://"^(List.fold_left Filename.concat (Coq_config.docdir) ["refman";"html"]);
       Coq_config.wwwrefman;
       use_default_doc_url
     ] in
@@ -883,7 +931,7 @@ let configure ?(apply=(fun () -> ())) () =
       doc_url#get in
   let library_url =
     let predefined = [
-      "file://"^(List.fold_left Filename.concat (Coq_config.docdir) ["html";"stdlib";""]);
+      "file://"^(List.fold_left Filename.concat (Coq_config.docdir) ["stdlib";"html"]);
       Coq_config.wwwstdlib
     ] in
     combo
@@ -908,6 +956,36 @@ let configure ?(apply=(fun () -> ())) () =
   let misc = [contextual_menus_on_goal;stop_before;reset_on_tab_switch;
               vertical_tabs;opposite_tabs] in
 
+  let add_user_query () =
+    let input_string l v =
+      match GToolbox.input_string ~title:l v with
+      | None -> ""
+      | Some s -> s
+    in
+    let q = input_string "User query" "Your query" in
+    let k = input_string "Shortcut key" "Shortcut (a single letter)" in
+    let q = CString.map (fun c -> if c = '$' then ' ' else c) q in
+    (* Anything that is not a simple letter will be ignored. *)
+    let k =
+      if Int.equal (CString.length k) 1 && Util.is_letter k.[0] then k
+      else "" in
+    let k = CString.uppercase k in
+      [q, k]
+  in
+
+  let user_queries =
+    list
+      ~f:user_queries#set
+      (* Disallow same query, key or empty query. *)
+      ~eq:(fun (q1, k1) (q2, k2) -> k1 = k2 || q1 = "" || q2 = "" || q1 = q2)
+      ~add:add_user_query
+      ~titles:["User query"; "Shortcut key"]
+      "User queries"
+      (fun (q, s) -> [q; s])
+      user_queries#get
+
+  in
+
 (* ATTENTION !!!!! L'onglet Fonts doit etre en premier pour eviter un bug !!!!
    (shame on Benjamin) *)
   let cmds =
@@ -921,7 +999,7 @@ let configure ?(apply=(fun () -> ())) () =
      Section("Files", Some `DIRECTORY,
 	     [global_auto_revert;global_auto_revert_delay;
 	      auto_save; auto_save_delay; (* auto_save_name*)
-	      encodings;
+	      encodings; line_ending;
 	     ]);
      Section("Project", Some (`STOCK "gtk-page-setup"),
 	     [project_file_name;read_project;
@@ -937,9 +1015,10 @@ let configure ?(apply=(fun () -> ())) () =
 	     [automatic_tactics]);
      Section("Shortcuts", Some `PREFERENCES,
 	     [modifiers_valid; modifier_for_tactics;
-	      modifier_for_templates; modifier_for_display; modifier_for_navigation]);
+        modifier_for_templates; modifier_for_display; modifier_for_navigation;
+        modifier_for_queries; user_queries]);
      Section("Misc", Some `ADD,
-	     misc)]
+       misc)]
   in
 (*
   Format.printf "before edit: current.text_font = %s@." (Pango.Font.to_string current.text_font);
diff --git a/ide/preferences.mli b/ide/preferences.mli
index 1733091a5..801869d1d 100644
--- a/ide/preferences.mli
+++ b/ide/preferences.mli
@@ -11,6 +11,7 @@ val style_manager : GSourceView2.source_style_scheme_manager
 
 type project_behavior = Ignore_args | Append_args | Subst_args
 type inputenc = Elocale | Eutf8 | Emanual of string
+type line_ending = [ `DEFAULT | `WINDOWS | `UNIX ]
 
 type tag = {
   tag_fg_color : string option;
@@ -65,6 +66,7 @@ val modifier_for_navigation : string preference
 val modifier_for_templates : string preference
 val modifier_for_tactics : string preference
 val modifier_for_display : string preference
+val modifier_for_queries : string preference
 val modifiers_valid : string preference
 val cmd_browse : string preference
 val cmd_editor : string preference
@@ -78,6 +80,7 @@ val window_height : int preference
 val auto_complete : bool preference
 val stop_before : bool preference
 val reset_on_tab_switch : bool preference
+val line_ending : line_ending preference
 val vertical_tabs : bool preference
 val opposite_tabs : bool preference
 val background_color : string preference
@@ -95,6 +98,7 @@ val spaces_instead_of_tabs : bool preference
 val tab_length : int preference
 val highlight_current_line : bool preference
 val nanoPG : bool preference
+val user_queries : (string * string) list preference
 
 val save_pref : unit -> unit
 val load_pref : unit -> unit
diff --git a/printing/richprinter.ml b/ide/richprinter.ml
index 5f39f36ea..995cef1ac 100644
--- a/printing/richprinter.ml
+++ b/ide/richprinter.ml
@@ -2,7 +2,6 @@ open Richpp
 
 module RichppConstr = Ppconstr.Richpp
 module RichppVernac = Ppvernac.Richpp
-module RichppTactic = Pptactic.Richpp
 
 type rich_pp =
     Ppannotation.t Richpp.located Xml_datatype.gxml
diff --git a/printing/richprinter.mli b/ide/richprinter.mli
index c9e84e3eb..c9e84e3eb 100644
--- a/printing/richprinter.mli
+++ b/ide/richprinter.mli
diff --git a/ide/sentence.ml b/ide/sentence.ml
index 6897779e8..e332682dd 100644
--- a/ide/sentence.ml
+++ b/ide/sentence.ml
@@ -16,6 +16,7 @@
 let split_slice_lax (buffer:GText.buffer) start stop =
   buffer#remove_tag ~start ~stop Tags.Script.sentence;
   buffer#remove_tag ~start ~stop Tags.Script.error;
+  buffer#remove_tag ~start ~stop Tags.Script.warning;
   buffer#remove_tag ~start ~stop Tags.Script.error_bg;
   let slice = buffer#get_text ~start ~stop () in
   let apply_tag off tag =
diff --git a/lib/serialize.ml b/ide/serialize.ml
index 685ec6049..7b568501e 100644
--- a/lib/serialize.ml
+++ b/ide/serialize.ml
@@ -8,7 +8,7 @@
 
 open Xml_datatype
 
-exception Marshal_error
+exception Marshal_error of string * xml
 
 (** Utility functions *)
 
@@ -19,30 +19,31 @@ let rec get_attr attr = function
 
 let massoc x l =
   try get_attr x l
-  with Not_found -> raise Marshal_error
+  with Not_found -> raise (Marshal_error("attribute " ^ x,PCData "not there"))
 
 let constructor t c args = Element (t, ["val", c], args)
 let do_match t mf = function
   | Element (s, attrs, args) when CString.equal s t ->
       let c = massoc "val" attrs in
       mf c args
-  | _ -> raise Marshal_error
+  | x -> raise (Marshal_error (t,x))
 
 let singleton = function
   | [x] -> x
-  | _ -> raise Marshal_error
+  | l -> raise (Marshal_error
+      ("singleton",PCData ("list of length " ^ string_of_int (List.length l))))
 
 let raw_string = function
   | [] -> ""
   | [PCData s] -> s
-  | _ -> raise Marshal_error
+  | x::_ -> raise (Marshal_error("raw string",x))
 
 (** Base types *)
 
 let of_unit () = Element ("unit", [], [])
 let to_unit : xml -> unit = function
   | Element ("unit", [], []) -> ()
-  | _ -> raise Marshal_error
+  | x -> raise (Marshal_error ("unit",x))
 
 let of_bool (b : bool) : xml =
   if b then constructor "bool" "true" []
@@ -50,13 +51,13 @@ let of_bool (b : bool) : xml =
 let to_bool : xml -> bool = do_match "bool" (fun s _ -> match s with
   | "true" -> true
   | "false" -> false
-  | _ -> raise Marshal_error)
+  | x -> raise (Marshal_error("bool",PCData x)))
 
 let of_list (f : 'a -> xml) (l : 'a list) =
   Element ("list", [], List.map f l)
 let to_list (f : xml -> 'a) : xml -> 'a list = function
   | Element ("list", [], l) -> List.map f l
-  | _ -> raise Marshal_error
+  | x -> raise (Marshal_error("list",x))
 
 let of_option (f : 'a -> xml) : 'a option -> xml = function
   | None -> Element ("option", ["val", "none"], [])
@@ -64,24 +65,24 @@ let of_option (f : 'a -> xml) : 'a option -> xml = function
 let to_option (f : xml -> 'a) : xml -> 'a option = function
   | Element ("option", ["val", "none"], []) -> None
   | Element ("option", ["val", "some"], [x]) -> Some (f x)
-  | _ -> raise Marshal_error
+  | x -> raise (Marshal_error("option",x))
 
 let of_string (s : string) : xml = Element ("string", [], [PCData s])
 let to_string : xml -> string = function
   | Element ("string", [], l) -> raw_string l
-  | _ -> raise Marshal_error
+  | x -> raise (Marshal_error("string",x))
 
 let of_int (i : int) : xml = Element ("int", [], [PCData (string_of_int i)])
 let to_int : xml -> int = function
   | Element ("int", [], [PCData s]) ->
-    (try int_of_string s with Failure _ -> raise Marshal_error)
-  | _ -> raise Marshal_error
+    (try int_of_string s with Failure _ -> raise(Marshal_error("int",PCData s)))
+  | x -> raise (Marshal_error("int",x))
 
 let of_pair (f : 'a -> xml) (g : 'b -> xml) (x : 'a * 'b) : xml =
   Element ("pair", [], [f (fst x); g (snd x)])
 let to_pair (f : xml -> 'a) (g : xml -> 'b) : xml -> 'a * 'b = function
   | Element ("pair", [], [x; y]) -> (f x, g y)
-  | _ -> raise Marshal_error
+  | x -> raise (Marshal_error("pair",x))
 
 let of_union (f : 'a -> xml) (g : 'b -> xml) : ('a,'b) CSig.union -> xml = function
   | CSig.Inl x -> Element ("union", ["val","in_l"], [f x])
@@ -89,7 +90,7 @@ let of_union (f : 'a -> xml) (g : 'b -> xml) : ('a,'b) CSig.union -> xml = funct
 let to_union (f : xml -> 'a) (g : xml -> 'b) : xml -> ('a,'b) CSig.union = function
   | Element ("union", ["val","in_l"], [x]) -> CSig.Inl (f x)
   | Element ("union", ["val","in_r"], [x]) -> CSig.Inr (g x)
-  | _ -> raise Marshal_error
+  | x -> raise (Marshal_error("union",x))
 
 (** More elaborate types *)
 
@@ -99,7 +100,7 @@ let to_edit_id = function
       let id = int_of_string i in
       assert (id <= 0 );
       id
-  | _ -> raise Marshal_error
+  | x -> raise (Marshal_error("edit_id",x))
 
 let of_loc loc =
   let start, stop = Loc.unloc loc in
@@ -107,14 +108,14 @@ let of_loc loc =
 let to_loc xml =
   match xml with
   | Element ("loc", l,[]) ->
+      let start = massoc "start" l in
+      let stop = massoc "stop" l in
       (try
-        let start = massoc "start" l in
-        let stop = massoc "stop" l in
         Loc.make_loc (int_of_string start, int_of_string stop)
-      with Not_found | Invalid_argument _ -> raise Marshal_error)
-  | _ -> raise Marshal_error
+      with Not_found | Invalid_argument _ -> raise (Marshal_error("loc",PCData(start^":"^stop))))
+  | x -> raise (Marshal_error("loc",x))
 
 let of_xml x = Element ("xml", [], [x])
 let to_xml xml = match xml with
 | Element ("xml", [], [x]) -> x
-| _ -> raise Marshal_error
+| x -> raise (Marshal_error("xml",x))
diff --git a/lib/serialize.mli b/ide/serialize.mli
index d7c14e7e7..bf9e184eb 100644
--- a/lib/serialize.mli
+++ b/ide/serialize.mli
@@ -8,7 +8,7 @@
 
 open Xml_datatype
 
-exception Marshal_error
+exception Marshal_error of string * xml
 
 val massoc: string -> (string * string) list -> string
 val constructor: string -> string -> xml list -> xml
diff --git a/ide/session.ml b/ide/session.ml
index cdec392ec..fc6340d28 100644
--- a/ide/session.ml
+++ b/ide/session.ml
@@ -108,10 +108,10 @@ let set_buffer_handlers
     let id = ref 0 in
     fun () -> incr id; !id in
   let running_action = ref None in
-  let cancel_signal reason =
+  let cancel_signal ?(stop_emit=true) reason =
     Minilib.log ("user_action cancelled: "^reason);
     action_was_cancelled := true;
-    GtkSignal.stop_emit () in
+    if stop_emit then GtkSignal.stop_emit () in
   let del_mark () =
     try buffer#delete_mark (`NAME "target")
     with GText.No_such_mark _ -> () in
@@ -124,7 +124,7 @@ let set_buffer_handlers
       fun () -> (* If Coq is busy due to the current action, we don't cancel *)
         match !running_action with
         | Some aid when aid = action -> ()
-        | _ -> cancel_signal "Coq busy" in
+        | _ -> cancel_signal ~stop_emit:false "Coq busy" in
     Coq.try_grab coqtop action fallback in
   let get_start () = buffer#get_iter_at_mark (`NAME "start_of_input") in
   let get_stop () = buffer#get_iter_at_mark (`NAME "stop_of_input") in
@@ -195,12 +195,8 @@ let set_buffer_handlers
          to a point indicated by coq. *)
       if !no_coq_action_required then begin
         let start, stop = get_start (), get_stop () in
-        buffer#remove_tag Tags.Script.error ~start ~stop;
-        buffer#remove_tag Tags.Script.error_bg ~start ~stop;
-        buffer#remove_tag Tags.Script.tooltip ~start ~stop;
-        buffer#remove_tag Tags.Script.processed ~start ~stop;
-        buffer#remove_tag Tags.Script.to_process ~start ~stop;
-        buffer#remove_tag Tags.Script.incomplete ~start ~stop;
+	List.iter (fun tag -> buffer#remove_tag tag ~start ~stop)
+		  Tags.Script.ephemere;
         Sentence.tag_on_insert buffer
       end;
     end in
diff --git a/ide/tags.ml b/ide/tags.ml
index 9ccff9fb5..e4510e7af 100644
--- a/ide/tags.ml
+++ b/ide/tags.ml
@@ -18,6 +18,7 @@ struct
   let table = GText.tag_table ()
   let comment = make_tag table ~name:"comment" []
   let error = make_tag table ~name:"error" [`UNDERLINE `SINGLE]
+  let warning = make_tag table ~name:"warning" [`UNDERLINE `SINGLE; `FOREGROUND "blue"]
   let error_bg = make_tag table ~name:"error_bg" []
   let to_process = make_tag table ~name:"to_process" []
   let processed = make_tag table ~name:"processed" []
@@ -29,9 +30,11 @@ struct
   let sentence = make_tag table ~name:"sentence" []
   let tooltip = make_tag table ~name:"tooltip" [] (* debug:`BACKGROUND "blue" *)
 
+  let ephemere =
+    [error; warning; error_bg; tooltip; processed; to_process; incomplete; unjustified]
+
   let all =
-    [comment; error; error_bg; to_process; processed; incomplete; unjustified;
-     found; sentence; tooltip]
+    comment :: found :: sentence :: ephemere
 
   let edit_zone =
     let t = make_tag table ~name:"edit_zone" [`UNDERLINE `SINGLE] in
diff --git a/ide/tags.mli b/ide/tags.mli
index 5a932f330..02e15a5ae 100644
--- a/ide/tags.mli
+++ b/ide/tags.mli
@@ -11,6 +11,7 @@ sig
   val table : GText.tag_table
   val comment : GText.tag
   val error : GText.tag
+  val warning : GText.tag
   val error_bg : GText.tag
   val to_process : GText.tag
   val processed : GText.tag
@@ -20,6 +21,7 @@ sig
   val sentence : GText.tag
   val tooltip : GText.tag
   val edit_zone : GText.tag (* for debugging *)
+  val ephemere : GText.tag list
   val all : GText.tag list
 end
 
diff --git a/stm/texmacspp.ml b/ide/texmacspp.ml
index d1d6de9ae..6fbed38fb 100644
--- a/stm/texmacspp.ml
+++ b/ide/texmacspp.ml
@@ -127,10 +127,6 @@ let xmlProofMode loc name = xmlWithLoc loc "proofmode" ["name",name] []
 
 let xmlProof loc xml = xmlWithLoc loc "proof" [] xml
 
-let xmlRawTactic name rtac =
-  Element("rawtactic", ["name",name],
-    [PCData (Pp.string_of_ppcmds (Pptactic.pr_raw_tactic rtac))])
-
 let xmlSectionSubsetDescr name ssd =
   Element("sectionsubsetdescr",["name",name],
     [PCData (Proof_using.to_string ssd)])
@@ -188,7 +184,9 @@ match sm with
       | LeftA -> ["associativity", "left"]
       end
   | SetEntryType (s, _) -> ["entrytype", s]
-  | SetOnlyParsing v -> ["compat", Flags.pr_version v]
+  | SetOnlyPrinting -> ["onlyprinting", ""]
+  | SetOnlyParsing -> ["onlyparsing", ""]
+  | SetCompatVersion v -> ["compat", Flags.pr_version v]
   | SetFormat (system, (loc, s)) ->
       let start, stop = unlock loc in
       ["format-"^system, s; "begin", start; "end", stop]
@@ -237,6 +235,8 @@ and pp_local_binder lb = (* don't know what it is for now *)
       let ppl =
         List.map (fun (loc, nam) -> (xmlCst (string_of_name nam) loc)) namll in
       xmlTyped (ppl @ [pp_expr ce])
+  | LocalPattern _ ->
+      assert false
 and pp_local_decl_expr lde = (* don't know what it is for now *)
   match lde with
   | AssumExpr (_, ce) -> pp_expr ce
@@ -350,6 +350,7 @@ and pp_cases_pattern_expr cpe =
       xmlApply loc
         (xmlOperator "delimiter" ~attr:["name", delim] loc ::
           [pp_cases_pattern_expr cpe])
+  | CPatCast _ -> assert false
 and pp_case_expr (e, name, pat) =
   match name, pat with
   | None, None -> xmlScrutinee [pp_expr e]
@@ -704,6 +705,7 @@ let rec tmpp v loc =
   | VernacSetStrategy _ as x -> xmlTODO loc x
   | VernacUnsetOption _ as x -> xmlTODO loc x
   | VernacSetOption _ as x -> xmlTODO loc x
+  | VernacSetAppendOption _ as x -> xmlTODO loc x
   | VernacAddOption _ as x -> xmlTODO loc x
   | VernacRemoveOption _ as x -> xmlTODO loc x
   | VernacMemOption _ as x -> xmlTODO loc x
@@ -738,7 +740,7 @@ let rec tmpp v loc =
   | VernacShow _ as x -> xmlTODO loc x
   | VernacCheckGuard as x -> xmlTODO loc x
   | VernacProof (tac,using) ->
-      let tac = Option.map (xmlRawTactic "closingtactic") tac in
+      let tac = None (** FIXME *) in
       let using = Option.map (xmlSectionSubsetDescr "using") using in
       xmlProof loc (Option.List.(cons tac (cons using [])))
   | VernacProofMode name -> xmlProofMode loc name
diff --git a/stm/texmacspp.mli b/ide/texmacspp.mli
index 858847fb6..858847fb6 100644
--- a/stm/texmacspp.mli
+++ b/ide/texmacspp.mli
diff --git a/ide/utils/config_file.ml b/ide/utils/config_file.ml
deleted file mode 100644
index 4d0aabeb6..000000000
--- a/ide/utils/config_file.ml
+++ /dev/null
@@ -1,640 +0,0 @@
-(*********************************************************************************)
-(*                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                                          *)
-(*                                                                               *)
-(*********************************************************************************)
-
-(* 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 forces a call to set_max_indent
-     sprintf et bprintf are flushed at each call*)
-
-  (* 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 Flags.****************** *)
-(* ******************************************************************************** *)
-
-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
deleted file mode 100644
index 22328e7f1..000000000
--- a/ide/utils/config_file.mli
+++ /dev/null
@@ -1,352 +0,0 @@
-(*********************************************************************************)
-(*                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 having more,
-for instance having 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 4606ef29f..69e8b647a 100644
--- a/ide/utils/configwin.ml
+++ b/ide/utils/configwin.ml
@@ -36,44 +36,16 @@ type return_button =
   | Return_ok
   | Return_cancel
 
-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 text = Configwin_ihm.text
 let strings = Configwin_ihm.strings
 let list = Configwin_ihm.list
 let bool = Configwin_ihm.bool
-let filename = Configwin_ihm.filename
-let filenames = Configwin_ihm.filenames
-let color = Configwin_ihm.color
-let font = Configwin_ihm.font
 let combo = Configwin_ihm.combo
 let custom = Configwin_ihm.custom
-let date = Configwin_ihm.date
-let hotkey = Configwin_ihm.hotkey
 let modifiers = Configwin_ihm.modifiers
-let html = Configwin_ihm.html
 
 let edit
     ?(apply=(fun () -> ()))
     title ?width ?height
     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
-    ?(apply=(fun () -> ()))
-    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
-    ~with_apply: false ~apply: (fun () -> ())
-
-let box = Configwin_ihm.box
-
-let tabbed_box = Configwin_ihm.tabbed_box
diff --git a/ide/utils/configwin.mli b/ide/utils/configwin.mli
index c5fbf39a0..7616e471d 100644
--- a/ide/utils/configwin.mli
+++ b/ide/utils/configwin.mli
@@ -50,22 +50,6 @@ type return_button =
 	 button or the window manager but never clicked
 	 on the apply button.*)
 
-
-(** {2 The key option class (to use with the {!Config_file} library)} *)
-
-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} *)
 
 (** [string label value] creates a string parameter.
@@ -136,24 +120,6 @@ val list : ?editable: bool -> ?help: string ->
 		  'a list ->
 		    parameter_kind
 
-(** [color label value] creates a color parameter.
-   @param editable indicate if the value is editable (default is [true]).
-   @param expand indicate if the entry widget must expand or not (default is [true]).
-   @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 ->
-  ?f: (string -> unit) -> string -> string -> parameter_kind
-
-(** [font label value] creates a font parameter.
-   @param editable indicate if the value is editable (default is [true]).
-   @param expand indicate if the entry widget must expand or not (default is [true]).
-   @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 ->
-  ?f: (string -> unit) -> string -> string -> parameter_kind
-
 (** [combo label choices value] creates a combo parameter.
    @param editable indicate if the value is editable (default is [true]).
    @param expand indicate if the entry widget must expand or not (default is [true]).
@@ -169,69 +135,6 @@ val combo : ?editable: bool -> ?expand: bool -> ?help: string ->
     ?new_allowed: bool -> ?blank_allowed: bool ->
       string -> string list -> string -> parameter_kind
 
-(** [text label value] creates a text parameter.
-   @param editable indicate if the value is editable (default is [true]).
-   @param expand indicate if the box for the text must expand or not (default is [true]).
-   @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 ->
-  ?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
-   to edit your bindings.
-*)
-val html : ?editable: bool -> ?expand: bool -> ?help: string ->
-  ?f: (string -> unit) -> string -> string -> parameter_kind
-
-(** [filename label value] creates a filename parameter.
-   @param editable indicate if the value is editable (default is [true]).
-   @param expand indicate if the entry widget must expand or not (default is [true]).
-   @param help an optional help message.
-   @param f the function called to apply the value (default function does nothing).
-*)
-val filename : ?editable: bool -> ?expand: bool -> ?help: string ->
-  ?f: (string -> unit) -> string -> string -> parameter_kind
-
-(** [filenames label value] creates a filename list parameter.
-   @param editable indicate if the value is editable (default is [true]).
-   @param help an optional help message.
-   @param f the function called to apply the value (default function does nothing).
-   @param eq the comparison function, used not to have doubles in list. Default
-   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) ->
-    ?eq: (string -> string -> bool) ->
-      string -> string list -> parameter_kind
-
-(** [date label value] creates a date parameter.
-   @param editable indicate if the value is editable (default is [true]).
-   @param expand indicate if the entry widget must expand or not (default is [true]).
-   @param help an optional help message.
-   @param f the function called to apply the value (default function does nothing).
-   @param f_string the function used to display the date as a string. The parameter
-   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) ->
-    ?f_string: ((int * int * int -> string)) ->
-      string -> (int * int * int) -> parameter_kind
-
-(** [hotkey label value] creates a hot key parameter.
-   A hot key is defined by a list of modifiers and a key code.
-   @param editable indicate if the value is editable (default is [true]).
-   @param expand indicate if the entry widget must expand or not (default is [true]).
-   @param help an optional help message.
-   @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) ->
-    string -> (Gdk.Tags.modifier list * int) -> parameter_kind
-
 val modifiers : ?editable: bool -> ?expand: bool -> ?help: string ->
   ?allow:(Gdk.Tags.modifier list) ->
   ?f: (Gdk.Tags.modifier list -> unit) ->
@@ -259,46 +162,3 @@ val edit :
   ?height:int ->
   configuration_structure list ->
   return_button
-
-(** This function takes a configuration structure and creates a window used
-   to get the various parameters from the user. It is the same window as edit but
-   there is no apply button.*)
-val get :
-  string ->
-  ?width:int ->
-  ?height:int ->
-  configuration_structure list ->
-  return_button
-
-(** 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
-   giving new values to parameters.*)
-val simple_edit :
-  ?apply: (unit -> unit) ->
-  string ->
-  ?width:int ->
-  ?height:int ->
-  parameter_kind list -> return_button
-
-(** This function takes a list of parameter specifications and
-   creates a window to configure the various parameters,
-   without Apply button.*)
-val simple_get :
-  string ->
-  ?width:int ->
-  ?height:int ->
-  parameter_kind list -> return_button
-
-(** Create a [GPack.box] with the list of given parameters,
-   Return the box and the function to call to apply new values to parameters.
-*)
-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 -> GData.tooltips -> GPack.box
diff --git a/ide/utils/configwin_ihm.ml b/ide/utils/configwin_ihm.ml
index c1062a9db..70133fb9f 100644
--- a/ide/utils/configwin_ihm.ml
+++ b/ide/utils/configwin_ihm.ml
@@ -27,7 +27,25 @@
 
 open Configwin_types
 
-module O = Config_file
+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 ""
 
 class type widget =
   object
@@ -35,112 +53,9 @@ class type widget =
     method apply : unit -> unit
   end
 
-let file_html_config = Filename.concat Configwin_messages.home ".configwin_html"
-
 let debug = false
 let dbg s = if debug then Minilib.log s else ()
 
-(** Return the config group for the html config file,
-   and the option for bindings. *)
-let html_config_file_and_option () =
-  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 = Configwin_types.string_to_key "A-i" ;
-	  html_begin = "<i>";
-	  html_end = "</i>" ;
-	}
-      ]
-      ""
-  in
-  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 changing 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 fs = GWindow.file_selection ~modal:true
-      ~title: the_title () in
-  (* we set the previous directory, if no directory is given *)
-  (
-   match dir with
-     None ->
-       if !last_dir <> "" then
-         let _ = fs#set_filename !last_dir in
-         ()
-       else
-         ()
-  | Some 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
-        None ->
-          (fun () -> files := [fs#filename] ; fs#destroy ())
-      | Some f ->
-          (fun () -> f fs#filename)
-      )
-  in
-  let _ = fs # cancel_button # connect#clicked ~callback:fs#destroy in
-  fs # show ();
-  GMain.Main.main ();
-  match !files with
-  | [] ->
-      []
-  | [""] ->
-      []
-  | l ->
-      (* we keep the directory in last_dir *)
-      last_dir := Filename.dirname (List.hd l);
-      l
-;;
-
-(** Make the user select a date. *)
-let select_date title (day,mon,year) =
-  let v_opt = ref None in
-  let window = GWindow.dialog ~modal:true ~title () in
-  let hbox = GPack.hbox ~border_width:10 ~packing:window#vbox#add () in
-  let cal = GMisc.calendar ~packing: (hbox#pack ~expand: true) () in
-  cal#select_month ~month: mon ~year: year ;
-  cal#select_day day;
-  let bbox = window#action_area in
-
-  let bok = GButton.button ~label: Configwin_messages.mOk
-      ~packing:(bbox#pack ~expand:true ~padding:4) ()
-  in
-  let bcancel = GButton.button ~label: Configwin_messages.mCancel
-      ~packing:(bbox#pack ~expand:true ~padding:4) ()
-  in
-  ignore (bok#connect#clicked ~callback:
-	    (fun () -> v_opt := Some (cal#date); window#destroy ()));
-  ignore(bcancel#connect#clicked ~callback: window#destroy);
-
-  bok#grab_default ();
-  ignore(window#connect#destroy ~callback: GMain.Main.quit);
-  window#set_position `CENTER;
-  window#show ();
-  GMain.Main.main ();
-  !v_opt
-
-
 (** This class builds a frame with a clist and two buttons :
    one to add items and one to remove the selected items.
    The class takes in parameter a function used to add items and
@@ -460,164 +375,6 @@ class custom_param_box param (tt:GData.tooltips) =
     method apply = param.custom_f_apply ()
   end
 
-(** This class is used to build a box for a color parameter.*)
-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) ()
-  in
-  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 _ =
-    match param.color_help with
-      None -> ()
-    | Some 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_fg [ (`NORMAL, `NAME s) ; ]
-     with _ -> ()
-    );
-    w_test#misc#set_style style;
-  in
-  let _ = set_color !v in
-  let _ = we#set_text !v in
-  let f_sel () =
-    let dialog = GWindow.color_selection_dialog
-	~title: param.color_label
-	~modal: true
-	~show: true
-	()
-    in
-    let wb_ok = dialog#ok_button in
-    let wb_cancel = dialog#cancel_button in
-    let _ = dialog#connect#destroy ~callback:GMain.Main.quit in
-    let _ = wb_ok#connect#clicked
-	~callback:(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 ; *)
-	  dialog#destroy ()
-	)
-    in
-    let _ = wb_cancel#connect#clicked ~callback:dialog#destroy in
-    GMain.Main.main ()
-  in
-  let _ =
-    if param.color_editable then ignore (wb#connect#clicked ~callback:f_sel)
-  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
-      if new_value <> param.color_value then
-	let _ = param.color_f_apply new_value in
-	param.color_value <- new_value
-      else
-	()
-
-    initializer
-      ignore (we#connect#changed ~callback:(fun () -> set_color we#text));
-
-  end ;;
-
-(** This class is used to build a box for a font parameter.*)
-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) ()
-  in
-  let we = GEdit.entry
-      ~editable: false
-      ~packing: (hbox#pack ~expand: param.font_expand ~padding: 2)
-      ()
-  in
-  let _ =
-    match param.font_help with
-      None -> ()
-    | Some help ->
-	tt#set_tip ~text: help ~privat: help wb#coerce
-  in
-  let set_entry_font font_opt =
-    match font_opt with
-      None -> ()
-    | Some s ->
-	let style = we#misc#style#copy in
-	(
-	 try
-	   let font = Gdk.Font.load_fontset s in
-	   style#set_font font
-	 with _ -> ()
-	);
-	we#misc#set_style style
-  in
-  let _ = set_entry_font (Some !v) in
-  let _ = we#set_text !v in
-  let f_sel () =
-    let dialog = GWindow.font_selection_dialog
-	~title: param.font_label
-	~modal: true
-	~show: true
-	()
-    in
-    dialog#selection#set_font_name !v;
-    let wb_ok = dialog#ok_button in
-    let wb_cancel = dialog#cancel_button in
-    let _ = dialog#connect#destroy ~callback:GMain.Main.quit in
-    let _ = wb_ok#connect#clicked
-	~callback:(fun () ->
-	  let font = dialog#selection#font_name in
-	  we#set_text font ;
-	  set_entry_font (Some font);
-	  dialog#destroy ()
-	)
-    in
-    let _ = wb_cancel#connect#clicked ~callback:dialog#destroy in
-    GMain.Main.main ()
-  in
-  let _ = if param.font_editable then ignore (wb#connect#clicked ~callback:f_sel) 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
-      if new_value <> param.font_value then
-	let _ = param.font_f_apply new_value in
-	param.font_value <- new_value
-      else
-	()
-  end ;;
-
 (** This class is used to build a box for a text parameter.*)
 class text_param_box param (tt:GData.tooltips) =
   let _ = dbg "text_param_box" in
@@ -662,35 +419,6 @@ class text_param_box param (tt:GData.tooltips) =
 	()
   end ;;
 
-(** This class is used to build a box a html parameter. *)
-class html_param_box param (tt:GData.tooltips) =
-  let _ = dbg "html_param_box" in
-  object (self)
-    inherit text_param_box param tt
-
-    method private exec html_start html_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 wview ~mods k (self#exec hb.html_begin hb.html_end)
-      in
-      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 (tt:GData.tooltips) =
   let _ = dbg "bool_param_box" in
@@ -719,105 +447,6 @@ class bool_param_box param (tt:GData.tooltips) =
 	()
   end ;;
 
-(** This class is used to build a box for a file name parameter.*)
-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) ()
-  in
-  let we = GEdit.entry
-      ~editable: param.string_editable
-      ~packing: (hbox#pack ~expand: param.string_expand ~padding: 2)
-      ()
-  in
-  let _ =
-    match param.string_help with
-      None -> ()
-    | Some help ->
-	tt#set_tip ~text: help ~privat: help wb#coerce
-  in
-  let _ = we#set_text (param.string_to_string param.string_value) in
-
-  let f_click () =
-    match select_files param.string_label with
-      [] ->
-        ()
-    | f :: _ ->
-        we#set_text f
-  in
-  let _ =
-    if param.string_editable then
-      let _ = wb#connect#clicked ~callback:f_click in
-      ()
-    else
-      ()
-  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 = 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
-      else
-	()
-  end ;;
-
-(** This class is used to build a box for a hot key parameter.*)
-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 () in
-  let we = GEdit.entry
-      ~editable: false
-      ~packing: (hbox#pack ~expand: param.hk_expand ~padding: 2)
-      ()
-  in
-  let value = ref param.hk_value in
-  let _ =
-    match param.hk_help with
-      None -> ()
-    | Some help ->
-	tt#set_tip ~text: help ~privat: help wev#coerce
-  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
-    let modifiers = GdkEvent.Key.state ev in
-    let mods = List.filter
-	(fun m -> not (List.mem m mods_we_dont_care))
-	modifiers
-    in
-    value := (mods, key);
-    we#set_text (Glib.Convert.locale_to_utf8 (Configwin_types.key_to_string !value));
-    false
-  in
-  let _ =
-    if param.hk_editable then
-      ignore (we#event#connect#key_press ~callback:capture)
-    else
-      ()
-  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 = !value in
-      if new_value <> param.hk_value then
-	let _ = param.hk_f_apply new_value in
-	param.hk_value <- new_value
-      else
-	()
-  end ;;
-
 class modifiers_param_box param =
   let hbox = GPack.hbox () in
   let wev = GBin.event_box ~packing: (hbox#pack ~expand:true ~fill:true ~padding: 2) () in
@@ -825,7 +454,7 @@ class modifiers_param_box param =
   let value = ref param.md_value in
   let _ = List.map (fun modifier ->
                       let but = GButton.toggle_button
-                                  ~label:(Configwin_types.modifiers_to_string [modifier])
+                                  ~label:(modifiers_to_string [modifier])
                                   ~active:(List.mem modifier param.md_value)
                                   ~packing:(hbox#pack ~expand:false) () in
                       ignore (but#connect#toggled
@@ -854,55 +483,6 @@ class modifiers_param_box param =
 	()
   end ;;
 
-(** This class is used to build a box for a date parameter.*)
-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) ()
-  in
-  let we = GEdit.entry
-      ~editable: false
-      ~packing: (hbox#pack ~expand: param.date_expand ~padding: 2)
-      ()
-  in
-
-  let _ =
-    match param.date_help with
-      None -> ()
-    | Some help ->
-	tt#set_tip ~text: help ~privat: help wb#coerce
-  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) ->
-	v := (d,m,y) ;
-	we#set_text (param.date_f_string (d,m,y))
-  in
-  let _ =
-    if param.date_editable then
-      let _ = wb#connect#clicked ~callback:f_click in
-      ()
-    else
-      ()
-  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 =
-      if !v <> param.date_value then
-	let _ = param.date_f_apply !v in
-	param.date_value <- !v
-      else
-	()
-  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) (tt:GData.tooltips) =
   let _ = dbg "list_param_box" in
@@ -975,10 +555,6 @@ class configuration_box (tt : GData.tooltips) conf_struct =
     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
@@ -987,30 +563,10 @@ class configuration_box (tt : GData.tooltips) conf_struct =
     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 set_icon iter = function
@@ -1102,36 +658,6 @@ class configuration_box (tt : GData.tooltips) conf_struct =
 
   end
 
-(** Create a vbox 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.
-*)
-let tabbed_box conf_struct_list buttons tooltips =
-  let param_box =
-       new configuration_box tooltips conf_struct_list
-  in
-  let f_apply () = param_box#apply
-  in
-  let hbox_buttons = GPack.hbox ~packing: (param_box#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 ();
-
-        iter_buttons q
-  in
-  iter_buttons ~grab: true buttons;
-
-  param_box#box
-
 (** This function takes a configuration structure list and creates a window
    to configure the various parameters. *)
 let edit ?(with_apply=true)
@@ -1174,110 +700,6 @@ let edit ?(with_apply=true)
   in
     iter Return_cancel
 
-(** 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 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_param_box = List.map f param_list in
-  let f_apply () =
-    List.iter (fun param_box -> param_box#apply) list_param_box
-  in
-  (main_box, f_apply)
-
-(** 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
-  let tooltips = GData.tooltips () 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 (box, f_apply) = box param_list tooltips in
-  dialog#vbox#pack ~expand: true ~fill: true box#coerce;
-
-  let destroy () =
-    tooltips#destroy () ;
-    dialog#destroy ();
-  in
-  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 ~title:"Error" s; iter rep
-    | e ->
-	GToolbox.message_box ~title:"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
@@ -1342,30 +764,6 @@ let strings ?(editable=true) ?help
     ?(add=(fun () -> [])) label v =
   list ~editable ?help ~f ~eq ~edit: (edit_string label) ~add label (fun s -> [s]) v
 
-(** Create a color param. *)
-let color ?(editable=true) ?(expand=true) ?help ?(f=(fun _ -> ())) label v =
-  Color_param
-    {
-      color_label = label ;
-      color_help = help ;
-      color_value = v ;
-      color_editable = editable ;
-      color_f_apply = f ;
-      color_expand = expand ;
-    }
-
-(** Create a font param. *)
-let font ?(editable=true) ?(expand=true) ?help ?(f=(fun _ -> ())) label v =
-  Font_param
-    {
-      font_label = label ;
-      font_help = help ;
-      font_value = v ;
-      font_editable = editable ;
-      font_f_apply = f ;
-      font_expand = expand ;
-    }
-
 (** Create a combo param. *)
 let combo ?(editable=true) ?(expand=true) ?help ?(f=(fun _ -> ()))
     ?(new_allowed=false)
@@ -1383,82 +781,6 @@ let combo ?(editable=true) ?(expand=true) ?help ?(f=(fun _ -> ()))
       combo_expand = expand ;
     }
 
-(** Create a text param. *)
-let text ?(editable=true) ?(expand=true) ?help ?(f=(fun _ -> ())) label v =
-  Text_param
-    {
-      string_label = label ;
-      string_help = help ;
-      string_value = 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 html param. *)
-let html ?(editable=true) ?(expand=true) ?help ?(f=(fun _ -> ())) label v =
-  Html_param
-    {
-      string_label = label ;
-      string_help = help ;
-      string_value = 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 =
-  Filename_param
-    {
-      string_label = label ;
-      string_help = help ;
-      string_value = 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 _ -> ()))
-    ?(eq=Pervasives.(=))
-    label v =
-  let add () = select_files label in
-  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 _ -> ()))
-    ?(f_string=(fun(d,m,y)-> Printf.sprintf "%d/%d/%d" y (m+1) d))
-    label v =
-  Date_param
-    {
-      date_label = label ;
-      date_help = help ;
-      date_value = v ;
-      date_editable = editable ;
-      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 =
-  Hotkey_param
-    {
-      hk_label = label ;
-      hk_help = help ;
-      hk_value = v ;
-      hk_editable = editable ;
-      hk_f_apply = f ;
-      hk_expand = expand ;
-    }
-
 let modifiers
   ?(editable=true)
   ?(expand=true)
diff --git a/ide/utils/configwin_ihm.mli b/ide/utils/configwin_ihm.mli
new file mode 100644
index 000000000..c867ad912
--- /dev/null
+++ b/ide/utils/configwin_ihm.mli
@@ -0,0 +1,66 @@
+(*********************************************************************************)
+(*                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                                          *)
+(*                                                                               *)
+(*********************************************************************************)
+
+open Configwin_types
+
+val string : ?editable: bool -> ?expand: bool -> ?help: string ->
+  ?f: (string -> unit) -> string -> string -> parameter_kind
+val bool : ?editable: bool -> ?help: string ->
+  ?f: (bool -> unit) -> string -> bool -> parameter_kind
+val strings : ?editable: bool -> ?help: string ->
+  ?f: (string list -> unit) ->
+    ?eq: (string -> string -> bool) ->
+      ?add: (unit -> string list) ->
+        string -> string list -> parameter_kind
+val list : ?editable: bool -> ?help: string ->
+  ?f: ('a list -> unit) ->
+    ?eq: ('a -> 'a -> bool) ->
+      ?edit: ('a -> 'a) ->
+        ?add: (unit -> 'a list) ->
+          ?titles: string list ->
+            ?color: ('a -> string option) ->
+              string ->
+                ('a -> string list) ->
+                  'a list ->
+                    parameter_kind
+val combo : ?editable: bool -> ?expand: bool -> ?help: string ->
+  ?f: (string -> unit) ->
+    ?new_allowed: bool -> ?blank_allowed: bool ->
+      string -> string list -> string -> parameter_kind
+
+val modifiers : ?editable: bool -> ?expand: bool -> ?help: string ->
+  ?allow:(Gdk.Tags.modifier list) ->
+  ?f: (Gdk.Tags.modifier list -> unit) ->
+    string -> Gdk.Tags.modifier list -> parameter_kind
+val custom : ?label: string -> GPack.box -> (unit -> unit) -> bool -> parameter_kind
+
+val edit :
+  ?with_apply:bool ->
+  ?apply:(unit -> unit) ->
+  string ->
+  ?width:int ->
+  ?height:int ->
+  configuration_structure list ->
+  return_button
diff --git a/ide/utils/configwin_keys.ml b/ide/utils/configwin_keys.ml
deleted file mode 100644
index 9f44e5c6b..000000000
--- a/ide/utils/configwin_keys.ml
+++ /dev/null
@@ -1,4176 +0,0 @@
-(*********************************************************************************)
-(*                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
-
-   Ce fichier provient de X11/keysymdef.h
-   les noms des symboles deviennent : XK_ -> xk_
-
-   Thanks to Fabrice Le Fessant.
-*)
-
-let xk_VoidSymbol		= 0xFFFFFF	(** void symbol *)
-
-
-(** TTY Functions, cleverly chosen to map to ascii, for convenience of
-  programming, but could have been arbitrary (at the cost of lookup
-  tables in client code.
-*)
-
-let xk_BackSpace		= 0xFF08	(** back space, back char *)
-let xk_Tab			= 0xFF09
-let xk_Linefeed		= 0xFF0A	(** Linefeed, LF *)
-let xk_Clear		= 0xFF0B
-let xk_Return		= 0xFF0D	(** Return, enter *)
-let xk_Pause		= 0xFF13	(** Pause, hold *)
-let xk_Scroll_Lock		= 0xFF14
-let xk_Sys_Req		= 0xFF15
-let xk_Escape		= 0xFF1B
-let xk_Delete		= 0xFFFF	(** Delete, rubout *)
-
-
-
-(** International & multi-key character composition *)
-
-let xk_Multi_key		= 0xFF20  (** Multi-key character compose *)
-
-(** Japanese keyboard support *)
-
-let xk_Kanji		= 0xFF21	(** Kanji, Kanji convert *)
-let xk_Muhenkan		= 0xFF22  (** Cancel Conversion *)
-let xk_Henkan_Mode		= 0xFF23  (** Start/Stop Conversion *)
-let xk_Henkan		= 0xFF23  (** Alias for Henkan_Mode *)
-let xk_Romaji		= 0xFF24  (** to Romaji *)
-let xk_Hiragana		= 0xFF25  (** to Hiragana *)
-let xk_Katakana		= 0xFF26  (** to Katakana *)
-let xk_Hiragana_Katakana	= 0xFF27  (** Hiragana/Katakana toggle *)
-let xk_Zenkaku		= 0xFF28  (** to Zenkaku *)
-let xk_Hankaku		= 0xFF29  (** to Hankaku *)
-let xk_Zenkaku_Hankaku	= 0xFF2A  (** Zenkaku/Hankaku toggle *)
-let xk_Touroku		= 0xFF2B  (** Add to Dictionary *)
-let xk_Massyo		= 0xFF2C  (** Delete from Dictionary *)
-let xk_Kana_Lock		= 0xFF2D  (** Kana Lock *)
-let xk_Kana_Shift		= 0xFF2E  (** Kana Shift *)
-let xk_Eisu_Shift		= 0xFF2F  (** Alphanumeric Shift *)
-let xk_Eisu_toggle		= 0xFF30  (** Alphanumeric toggle *)
-
-(** = 0xFF31 thru = 0xFF3F are under xk_KOREAN *)
-
-(** Cursor control & motion *)
-
-let xk_Home			= 0xFF50
-let xk_Left			= 0xFF51	(** Move left, left arrow *)
-let xk_Up			= 0xFF52	(** Move up, up arrow *)
-let xk_Right		= 0xFF53	(** Move right, right arrow *)
-let xk_Down			= 0xFF54	(** Move down, down arrow *)
-let xk_Prior		= 0xFF55	(** Prior, previous *)
-let xk_Page_Up		= 0xFF55
-let xk_Next			= 0xFF56	(** Next *)
-let xk_Page_Down		= 0xFF56
-let xk_End			= 0xFF57	(** EOL *)
-let xk_Begin		= 0xFF58	(** BOL *)
-
-
-(** Misc Functions *)
-
-let xk_Select		= 0xFF60	(** Select, mark *)
-let xk_Print		= 0xFF61
-let xk_Execute		= 0xFF62	(** Execute, run, do *)
-let xk_Insert		= 0xFF63	(** Insert, insert here *)
-let xk_Undo			= 0xFF65	(** Undo, oops *)
-let xk_Redo			= 0xFF66	(** redo, again *)
-let xk_Menu			= 0xFF67
-let xk_Find			= 0xFF68	(** Find, search *)
-let xk_Cancel		= 0xFF69	(** Cancel, stop, abort, exit *)
-let xk_Help			= 0xFF6A	(** Help *)
-let xk_Break		= 0xFF6B
-let xk_Mode_switch		= 0xFF7E	(** Character set switch *)
-let xk_script_switch        = 0xFF7E  (** Alias for mode_switch *)
-let xk_Num_Lock		= 0xFF7F
-
-(** Keypad Functions, keypad numbers cleverly chosen to map to ascii *)
-
-let xk_KP_Space		= 0xFF80	(** space *)
-let xk_KP_Tab		= 0xFF89
-let xk_KP_Enter		= 0xFF8D	(** enter *)
-let xk_KP_F1		= 0xFF91	(** PF1, KP_A, ... *)
-let xk_KP_F2		= 0xFF92
-let xk_KP_F3		= 0xFF93
-let xk_KP_F4		= 0xFF94
-let xk_KP_Home		= 0xFF95
-let xk_KP_Left		= 0xFF96
-let xk_KP_Up		= 0xFF97
-let xk_KP_Right		= 0xFF98
-let xk_KP_Down		= 0xFF99
-let xk_KP_Prior		= 0xFF9A
-let xk_KP_Page_Up		= 0xFF9A
-let xk_KP_Next		= 0xFF9B
-let xk_KP_Page_Down		= 0xFF9B
-let xk_KP_End		= 0xFF9C
-let xk_KP_Begin		= 0xFF9D
-let xk_KP_Insert		= 0xFF9E
-let xk_KP_Delete		= 0xFF9F
-let xk_KP_Equal		= 0xFFBD	(** equals *)
-let xk_KP_Multiply		= 0xFFAA
-let xk_KP_Add		= 0xFFAB
-let xk_KP_Separator		= 0xFFAC	(** separator, often comma *)
-let xk_KP_Subtract		= 0xFFAD
-let xk_KP_Decimal		= 0xFFAE
-let xk_KP_Divide		= 0xFFAF
-
-let xk_KP_0			= 0xFFB0
-let xk_KP_1			= 0xFFB1
-let xk_KP_2			= 0xFFB2
-let xk_KP_3			= 0xFFB3
-let xk_KP_4			= 0xFFB4
-let xk_KP_5			= 0xFFB5
-let xk_KP_6			= 0xFFB6
-let xk_KP_7			= 0xFFB7
-let xk_KP_8			= 0xFFB8
-let xk_KP_9			= 0xFFB9
-
-
-
-(*
- * Auxilliary Functions; note the duplicate definitions for left and right
- * function keys;  Sun keyboards and a few other manufactures have such
- * function key groups on the left and/or right sides of the keyboard.
- * We've not found a keyboard with more than 35 function keys total.
- *)
-
-let xk_F1			= 0xFFBE
-let xk_F2			= 0xFFBF
-let xk_F3			= 0xFFC0
-let xk_F4			= 0xFFC1
-let xk_F5			= 0xFFC2
-let xk_F6			= 0xFFC3
-let xk_F7			= 0xFFC4
-let xk_F8			= 0xFFC5
-let xk_F9			= 0xFFC6
-let xk_F10			= 0xFFC7
-let xk_F11			= 0xFFC8
-let xk_L1			= 0xFFC8
-let xk_F12			= 0xFFC9
-let xk_L2			= 0xFFC9
-let xk_F13			= 0xFFCA
-let xk_L3			= 0xFFCA
-let xk_F14			= 0xFFCB
-let xk_L4			= 0xFFCB
-let xk_F15			= 0xFFCC
-let xk_L5			= 0xFFCC
-let xk_F16			= 0xFFCD
-let xk_L6			= 0xFFCD
-let xk_F17			= 0xFFCE
-let xk_L7			= 0xFFCE
-let xk_F18			= 0xFFCF
-let xk_L8			= 0xFFCF
-let xk_F19			= 0xFFD0
-let xk_L9			= 0xFFD0
-let xk_F20			= 0xFFD1
-let xk_L10			= 0xFFD1
-let xk_F21			= 0xFFD2
-let xk_R1			= 0xFFD2
-let xk_F22			= 0xFFD3
-let xk_R2			= 0xFFD3
-let xk_F23			= 0xFFD4
-let xk_R3			= 0xFFD4
-let xk_F24			= 0xFFD5
-let xk_R4			= 0xFFD5
-let xk_F25			= 0xFFD6
-let xk_R5			= 0xFFD6
-let xk_F26			= 0xFFD7
-let xk_R6			= 0xFFD7
-let xk_F27			= 0xFFD8
-let xk_R7			= 0xFFD8
-let xk_F28			= 0xFFD9
-let xk_R8			= 0xFFD9
-let xk_F29			= 0xFFDA
-let xk_R9			= 0xFFDA
-let xk_F30			= 0xFFDB
-let xk_R10			= 0xFFDB
-let xk_F31			= 0xFFDC
-let xk_R11			= 0xFFDC
-let xk_F32			= 0xFFDD
-let xk_R12			= 0xFFDD
-let xk_F33			= 0xFFDE
-let xk_R13			= 0xFFDE
-let xk_F34			= 0xFFDF
-let xk_R14			= 0xFFDF
-let xk_F35			= 0xFFE0
-let xk_R15			= 0xFFE0
-
-(** Modifiers *)
-
-let xk_Shift_L		= 0xFFE1	(** Left shift *)
-let xk_Shift_R		= 0xFFE2	(** Right shift *)
-let xk_Control_L		= 0xFFE3	(** Left control *)
-let xk_Control_R		= 0xFFE4	(** Right control *)
-let xk_Caps_Lock		= 0xFFE5	(** Caps lock *)
-let xk_Shift_Lock		= 0xFFE6	(** Shift lock *)
-
-let xk_Meta_L		= 0xFFE7	(** Left meta *)
-let xk_Meta_R		= 0xFFE8	(** Right meta *)
-let xk_Alt_L		= 0xFFE9	(** Left alt *)
-let xk_Alt_R		= 0xFFEA	(** Right alt *)
-let xk_Super_L		= 0xFFEB	(** Left super *)
-let xk_Super_R		= 0xFFEC	(** Right super *)
-let xk_Hyper_L		= 0xFFED	(** Left hyper *)
-let xk_Hyper_R		= 0xFFEE	(** Right hyper *)
-
-
-(*
- * ISO 9995 Function and Modifier Keys
- * Byte 3 = = 0xFE
- *)
-
-
-let	xk_ISO_Lock					= 0xFE01
-let	xk_ISO_Level2_Latch				= 0xFE02
-let	xk_ISO_Level3_Shift				= 0xFE03
-let	xk_ISO_Level3_Latch				= 0xFE04
-let	xk_ISO_Level3_Lock				= 0xFE05
-let	xk_ISO_Group_Shift		= 0xFF7E	(** Alias for mode_switch *)
-let	xk_ISO_Group_Latch				= 0xFE06
-let	xk_ISO_Group_Lock				= 0xFE07
-let	xk_ISO_Next_Group				= 0xFE08
-let	xk_ISO_Next_Group_Lock				= 0xFE09
-let	xk_ISO_Prev_Group				= 0xFE0A
-let	xk_ISO_Prev_Group_Lock				= 0xFE0B
-let	xk_ISO_First_Group				= 0xFE0C
-let	xk_ISO_First_Group_Lock				= 0xFE0D
-let	xk_ISO_Last_Group				= 0xFE0E
-let	xk_ISO_Last_Group_Lock				= 0xFE0F
-
-let	xk_ISO_Left_Tab					= 0xFE20
-let	xk_ISO_Move_Line_Up				= 0xFE21
-let	xk_ISO_Move_Line_Down				= 0xFE22
-let	xk_ISO_Partial_Line_Up				= 0xFE23
-let	xk_ISO_Partial_Line_Down			= 0xFE24
-let	xk_ISO_Partial_Space_Left			= 0xFE25
-let	xk_ISO_Partial_Space_Right			= 0xFE26
-let	xk_ISO_Set_Margin_Left				= 0xFE27
-let	xk_ISO_Set_Margin_Right				= 0xFE28
-let	xk_ISO_Release_Margin_Left			= 0xFE29
-let	xk_ISO_Release_Margin_Right			= 0xFE2A
-let	xk_ISO_Release_Both_Margins			= 0xFE2B
-let	xk_ISO_Fast_Cursor_Left				= 0xFE2C
-let	xk_ISO_Fast_Cursor_Right			= 0xFE2D
-let	xk_ISO_Fast_Cursor_Up				= 0xFE2E
-let	xk_ISO_Fast_Cursor_Down				= 0xFE2F
-let	xk_ISO_Continuous_Underline			= 0xFE30
-let	xk_ISO_Discontinuous_Underline			= 0xFE31
-let	xk_ISO_Emphasize				= 0xFE32
-let	xk_ISO_Center_Object				= 0xFE33
-let	xk_ISO_Enter					= 0xFE34
-
-let	xk_dead_grave					= 0xFE50
-let	xk_dead_acute					= 0xFE51
-let	xk_dead_circumflex				= 0xFE52
-let	xk_dead_tilde					= 0xFE53
-let	xk_dead_macron					= 0xFE54
-let	xk_dead_breve					= 0xFE55
-let	xk_dead_abovedot				= 0xFE56
-let	xk_dead_diaeresis				= 0xFE57
-let	xk_dead_abovering				= 0xFE58
-let	xk_dead_doubleacute				= 0xFE59
-let	xk_dead_caron					= 0xFE5A
-let	xk_dead_cedilla					= 0xFE5B
-let	xk_dead_ogonek					= 0xFE5C
-let	xk_dead_iota					= 0xFE5D
-let	xk_dead_voiced_sound				= 0xFE5E
-let	xk_dead_semivoiced_sound			= 0xFE5F
-let	xk_dead_belowdot				= 0xFE60
-
-let	xk_First_Virtual_Screen				= 0xFED0
-let	xk_Prev_Virtual_Screen				= 0xFED1
-let	xk_Next_Virtual_Screen				= 0xFED2
-let	xk_Last_Virtual_Screen				= 0xFED4
-let	xk_Terminate_Server				= 0xFED5
-
-let	xk_AccessX_Enable				= 0xFE70
-let	xk_AccessX_Feedback_Enable			= 0xFE71
-let	xk_RepeatKeys_Enable				= 0xFE72
-let	xk_SlowKeys_Enable				= 0xFE73
-let	xk_BounceKeys_Enable				= 0xFE74
-let	xk_StickyKeys_Enable				= 0xFE75
-let	xk_MouseKeys_Enable				= 0xFE76
-let	xk_MouseKeys_Accel_Enable			= 0xFE77
-let	xk_Overlay1_Enable				= 0xFE78
-let	xk_Overlay2_Enable				= 0xFE79
-let	xk_AudibleBell_Enable				= 0xFE7A
-
-let	xk_Pointer_Left					= 0xFEE0
-let	xk_Pointer_Right				= 0xFEE1
-let	xk_Pointer_Up					= 0xFEE2
-let	xk_Pointer_Down					= 0xFEE3
-let	xk_Pointer_UpLeft				= 0xFEE4
-let	xk_Pointer_UpRight				= 0xFEE5
-let	xk_Pointer_DownLeft				= 0xFEE6
-let	xk_Pointer_DownRight				= 0xFEE7
-let	xk_Pointer_Button_Dflt				= 0xFEE8
-let	xk_Pointer_Button1				= 0xFEE9
-let	xk_Pointer_Button2				= 0xFEEA
-let	xk_Pointer_Button3				= 0xFEEB
-let	xk_Pointer_Button4				= 0xFEEC
-let	xk_Pointer_Button5				= 0xFEED
-let	xk_Pointer_DblClick_Dflt			= 0xFEEE
-let	xk_Pointer_DblClick1				= 0xFEEF
-let	xk_Pointer_DblClick2				= 0xFEF0
-let	xk_Pointer_DblClick3				= 0xFEF1
-let	xk_Pointer_DblClick4				= 0xFEF2
-let	xk_Pointer_DblClick5				= 0xFEF3
-let	xk_Pointer_Drag_Dflt				= 0xFEF4
-let	xk_Pointer_Drag1				= 0xFEF5
-let	xk_Pointer_Drag2				= 0xFEF6
-let	xk_Pointer_Drag3				= 0xFEF7
-let	xk_Pointer_Drag4				= 0xFEF8
-let	xk_Pointer_Drag5				= 0xFEFD
-
-let	xk_Pointer_EnableKeys				= 0xFEF9
-let	xk_Pointer_Accelerate				= 0xFEFA
-let	xk_Pointer_DfltBtnNext				= 0xFEFB
-let	xk_Pointer_DfltBtnPrev				= 0xFEFC
-
-
-
-(*
- * 3270 Terminal Keys
- * Byte 3 = = 0xFD
- *)
-
-
-let xk_3270_Duplicate      = 0xFD01
-let xk_3270_FieldMark      = 0xFD02
-let xk_3270_Right2         = 0xFD03
-let xk_3270_Left2          = 0xFD04
-let xk_3270_BackTab        = 0xFD05
-let xk_3270_EraseEOF       = 0xFD06
-let xk_3270_EraseInput     = 0xFD07
-let xk_3270_Reset          = 0xFD08
-let xk_3270_Quit           = 0xFD09
-let xk_3270_PA1            = 0xFD0A
-let xk_3270_PA2            = 0xFD0B
-let xk_3270_PA3            = 0xFD0C
-let xk_3270_Test           = 0xFD0D
-let xk_3270_Attn           = 0xFD0E
-let xk_3270_CursorBlink    = 0xFD0F
-let xk_3270_AltCursor      = 0xFD10
-let xk_3270_KeyClick       = 0xFD11
-let xk_3270_Jump           = 0xFD12
-let xk_3270_Ident          = 0xFD13
-let xk_3270_Rule           = 0xFD14
-let xk_3270_Copy           = 0xFD15
-let xk_3270_Play           = 0xFD16
-let xk_3270_Setup          = 0xFD17
-let xk_3270_Record         = 0xFD18
-let xk_3270_ChangeScreen   = 0xFD19
-let xk_3270_DeleteWord     = 0xFD1A
-let xk_3270_ExSelect       = 0xFD1B
-let xk_3270_CursorSelect   = 0xFD1C
-let xk_3270_PrintScreen    = 0xFD1D
-let xk_3270_Enter          = 0xFD1E
-
-
-(*
- *  Latin 1
- *  Byte 3 = 0
- *)
-
-let xk_space               = 0x020
-let xk_exclam              = 0x021
-let xk_quotedbl            = 0x022
-let xk_numbersign          = 0x023
-let xk_dollar              = 0x024
-let xk_percent             = 0x025
-let xk_ampersand           = 0x026
-let xk_apostrophe          = 0x027
-let xk_quoteright          = 0x027	(** deprecated *)
-let xk_parenleft           = 0x028
-let xk_parenright          = 0x029
-let xk_asterisk            = 0x02a
-let xk_plus                = 0x02b
-let xk_comma               = 0x02c
-let xk_minus               = 0x02d
-let xk_period              = 0x02e
-let xk_slash               = 0x02f
-let xk_0                   = 0x030
-let xk_1                   = 0x031
-let xk_2                   = 0x032
-let xk_3                   = 0x033
-let xk_4                   = 0x034
-let xk_5                   = 0x035
-let xk_6                   = 0x036
-let xk_7                   = 0x037
-let xk_8                   = 0x038
-let xk_9                   = 0x039
-let xk_colon               = 0x03a
-let xk_semicolon           = 0x03b
-let xk_less                = 0x03c
-let xk_equal               = 0x03d
-let xk_greater             = 0x03e
-let xk_question            = 0x03f
-let xk_at                  = 0x040
-let xk_A                   = 0x041
-let xk_B                   = 0x042
-let xk_C                   = 0x043
-let xk_D                   = 0x044
-let xk_E                   = 0x045
-let xk_F                   = 0x046
-let xk_G                   = 0x047
-let xk_H                   = 0x048
-let xk_I                   = 0x049
-let xk_J                   = 0x04a
-let xk_K                   = 0x04b
-let xk_L                   = 0x04c
-let xk_M                   = 0x04d
-let xk_N                   = 0x04e
-let xk_O                   = 0x04f
-let xk_P                   = 0x050
-let xk_Q                   = 0x051
-let xk_R                   = 0x052
-let xk_S                   = 0x053
-let xk_T                   = 0x054
-let xk_U                   = 0x055
-let xk_V                   = 0x056
-let xk_W                   = 0x057
-let xk_X                   = 0x058
-let xk_Y                   = 0x059
-let xk_Z                   = 0x05a
-let xk_bracketleft         = 0x05b
-let xk_backslash           = 0x05c
-let xk_bracketright        = 0x05d
-let xk_asciicircum         = 0x05e
-let xk_underscore          = 0x05f
-let xk_grave               = 0x060
-let xk_quoteleft           = 0x060	(** deprecated *)
-let xk_a                   = 0x061
-let xk_b                   = 0x062
-let xk_c                   = 0x063
-let xk_d                   = 0x064
-let xk_e                   = 0x065
-let xk_f                   = 0x066
-let xk_g                   = 0x067
-let xk_h                   = 0x068
-let xk_i                   = 0x069
-let xk_j                   = 0x06a
-let xk_k                   = 0x06b
-let xk_l                   = 0x06c
-let xk_m                   = 0x06d
-let xk_n                   = 0x06e
-let xk_o                   = 0x06f
-let xk_p                   = 0x070
-let xk_q                   = 0x071
-let xk_r                   = 0x072
-let xk_s                   = 0x073
-let xk_t                   = 0x074
-let xk_u                   = 0x075
-let xk_v                   = 0x076
-let xk_w                   = 0x077
-let xk_x                   = 0x078
-let xk_y                   = 0x079
-let xk_z                   = 0x07a
-let xk_braceleft           = 0x07b
-let xk_bar                 = 0x07c
-let xk_braceright          = 0x07d
-let xk_asciitilde          = 0x07e
-
-let xk_nobreakspace        = 0x0a0
-let xk_exclamdown          = 0x0a1
-let xk_cent        	       = 0x0a2
-let xk_sterling            = 0x0a3
-let xk_currency            = 0x0a4
-let xk_yen                 = 0x0a5
-let xk_brokenbar           = 0x0a6
-let xk_section             = 0x0a7
-let xk_diaeresis           = 0x0a8
-let xk_copyright           = 0x0a9
-let xk_ordfeminine         = 0x0aa
-let xk_guillemotleft       = 0x0ab	(** left angle quotation mark *)
-let xk_notsign             = 0x0ac
-let xk_hyphen              = 0x0ad
-let xk_registered          = 0x0ae
-let xk_macron              = 0x0af
-let xk_degree              = 0x0b0
-let xk_plusminus           = 0x0b1
-let xk_twosuperior         = 0x0b2
-let xk_threesuperior       = 0x0b3
-let xk_acute               = 0x0b4
-let xk_mu                  = 0x0b5
-let xk_paragraph           = 0x0b6
-let xk_periodcentered      = 0x0b7
-let xk_cedilla             = 0x0b8
-let xk_onesuperior         = 0x0b9
-let xk_masculine           = 0x0ba
-let xk_guillemotright      = 0x0bb	(** right angle quotation mark *)
-let xk_onequarter          = 0x0bc
-let xk_onehalf             = 0x0bd
-let xk_threequarters       = 0x0be
-let xk_questiondown        = 0x0bf
-let xk_Agrave              = 0x0c0
-let xk_Aacute              = 0x0c1
-let xk_Acircumflex         = 0x0c2
-let xk_Atilde              = 0x0c3
-let xk_Adiaeresis          = 0x0c4
-let xk_Aring               = 0x0c5
-let xk_AE                  = 0x0c6
-let xk_Ccedilla            = 0x0c7
-let xk_Egrave              = 0x0c8
-let xk_Eacute              = 0x0c9
-let xk_Ecircumflex         = 0x0ca
-let xk_Ediaeresis          = 0x0cb
-let xk_Igrave              = 0x0cc
-let xk_Iacute              = 0x0cd
-let xk_Icircumflex         = 0x0ce
-let xk_Idiaeresis          = 0x0cf
-let xk_ETH                 = 0x0d0
-let xk_Eth                 = 0x0d0	(** deprecated *)
-let xk_Ntilde              = 0x0d1
-let xk_Ograve              = 0x0d2
-let xk_Oacute              = 0x0d3
-let xk_Ocircumflex         = 0x0d4
-let xk_Otilde              = 0x0d5
-let xk_Odiaeresis          = 0x0d6
-let xk_multiply            = 0x0d7
-let xk_Ooblique            = 0x0d8
-let xk_Ugrave              = 0x0d9
-let xk_Uacute              = 0x0da
-let xk_Ucircumflex         = 0x0db
-let xk_Udiaeresis          = 0x0dc
-let xk_Yacute              = 0x0dd
-let xk_THORN               = 0x0de
-let xk_Thorn               = 0x0de	(** deprecated *)
-let xk_ssharp              = 0x0df
-let xk_agrave              = 0x0e0
-let xk_aacute              = 0x0e1
-let xk_acircumflex         = 0x0e2
-let xk_atilde              = 0x0e3
-let xk_adiaeresis          = 0x0e4
-let xk_aring               = 0x0e5
-let xk_ae                  = 0x0e6
-let xk_ccedilla            = 0x0e7
-let xk_egrave              = 0x0e8
-let xk_eacute              = 0x0e9
-let xk_ecircumflex         = 0x0ea
-let xk_ediaeresis          = 0x0eb
-let xk_igrave              = 0x0ec
-let xk_iacute              = 0x0ed
-let xk_icircumflex         = 0x0ee
-let xk_idiaeresis          = 0x0ef
-let xk_eth                 = 0x0f0
-let xk_ntilde              = 0x0f1
-let xk_ograve              = 0x0f2
-let xk_oacute              = 0x0f3
-let xk_ocircumflex         = 0x0f4
-let xk_otilde              = 0x0f5
-let xk_odiaeresis          = 0x0f6
-let xk_division            = 0x0f7
-let xk_oslash              = 0x0f8
-let xk_ugrave              = 0x0f9
-let xk_uacute              = 0x0fa
-let xk_ucircumflex         = 0x0fb
-let xk_udiaeresis          = 0x0fc
-let xk_yacute              = 0x0fd
-let xk_thorn               = 0x0fe
-let xk_ydiaeresis          = 0x0ff
-
-
-(*
- *   Latin 2
- *   Byte 3 = 1
- *)
-
-
-let xk_Aogonek             = 0x1a1
-let xk_breve               = 0x1a2
-let xk_Lstroke             = 0x1a3
-let xk_Lcaron              = 0x1a5
-let xk_Sacute              = 0x1a6
-let xk_Scaron              = 0x1a9
-let xk_Scedilla            = 0x1aa
-let xk_Tcaron              = 0x1ab
-let xk_Zacute              = 0x1ac
-let xk_Zcaron              = 0x1ae
-let xk_Zabovedot           = 0x1af
-let xk_aogonek             = 0x1b1
-let xk_ogonek              = 0x1b2
-let xk_lstroke             = 0x1b3
-let xk_lcaron              = 0x1b5
-let xk_sacute              = 0x1b6
-let xk_caron               = 0x1b7
-let xk_scaron              = 0x1b9
-let xk_scedilla            = 0x1ba
-let xk_tcaron              = 0x1bb
-let xk_zacute              = 0x1bc
-let xk_doubleacute         = 0x1bd
-let xk_zcaron              = 0x1be
-let xk_zabovedot           = 0x1bf
-let xk_Racute              = 0x1c0
-let xk_Abreve              = 0x1c3
-let xk_Lacute              = 0x1c5
-let xk_Cacute              = 0x1c6
-let xk_Ccaron              = 0x1c8
-let xk_Eogonek             = 0x1ca
-let xk_Ecaron              = 0x1cc
-let xk_Dcaron              = 0x1cf
-let xk_Dstroke             = 0x1d0
-let xk_Nacute              = 0x1d1
-let xk_Ncaron              = 0x1d2
-let xk_Odoubleacute        = 0x1d5
-let xk_Rcaron              = 0x1d8
-let xk_Uring               = 0x1d9
-let xk_Udoubleacute        = 0x1db
-let xk_Tcedilla            = 0x1de
-let xk_racute              = 0x1e0
-let xk_abreve              = 0x1e3
-let xk_lacute              = 0x1e5
-let xk_cacute              = 0x1e6
-let xk_ccaron              = 0x1e8
-let xk_eogonek             = 0x1ea
-let xk_ecaron              = 0x1ec
-let xk_dcaron              = 0x1ef
-let xk_dstroke             = 0x1f0
-let xk_nacute              = 0x1f1
-let xk_ncaron              = 0x1f2
-let xk_odoubleacute        = 0x1f5
-let xk_udoubleacute        = 0x1fb
-let xk_rcaron              = 0x1f8
-let xk_uring               = 0x1f9
-let xk_tcedilla            = 0x1fe
-let xk_abovedot            = 0x1ff
-
-
-(*
- *   Latin 3
- *   Byte 3 = 2
- *)
-
-
-let xk_Hstroke             = 0x2a1
-let xk_Hcircumflex         = 0x2a6
-let xk_Iabovedot           = 0x2a9
-let xk_Gbreve              = 0x2ab
-let xk_Jcircumflex         = 0x2ac
-let xk_hstroke             = 0x2b1
-let xk_hcircumflex         = 0x2b6
-let xk_idotless            = 0x2b9
-let xk_gbreve              = 0x2bb
-let xk_jcircumflex         = 0x2bc
-let xk_Cabovedot           = 0x2c5
-let xk_Ccircumflex         = 0x2c6
-let xk_Gabovedot           = 0x2d5
-let xk_Gcircumflex         = 0x2d8
-let xk_Ubreve              = 0x2dd
-let xk_Scircumflex         = 0x2de
-let xk_cabovedot           = 0x2e5
-let xk_ccircumflex         = 0x2e6
-let xk_gabovedot           = 0x2f5
-let xk_gcircumflex         = 0x2f8
-let xk_ubreve              = 0x2fd
-let xk_scircumflex         = 0x2fe
-
-
-
-(*
- *   Latin 4
- *   Byte 3 = 3
- *)
-
-
-let xk_kra                 = 0x3a2
-let xk_kappa               = 0x3a2	(** deprecated *)
-let xk_Rcedilla            = 0x3a3
-let xk_Itilde              = 0x3a5
-let xk_Lcedilla            = 0x3a6
-let xk_Emacron             = 0x3aa
-let xk_Gcedilla            = 0x3ab
-let xk_Tslash              = 0x3ac
-let xk_rcedilla            = 0x3b3
-let xk_itilde              = 0x3b5
-let xk_lcedilla            = 0x3b6
-let xk_emacron             = 0x3ba
-let xk_gcedilla            = 0x3bb
-let xk_tslash              = 0x3bc
-let xk_ENG                 = 0x3bd
-let xk_eng                 = 0x3bf
-let xk_Amacron             = 0x3c0
-let xk_Iogonek             = 0x3c7
-let xk_Eabovedot           = 0x3cc
-let xk_Imacron             = 0x3cf
-let xk_Ncedilla            = 0x3d1
-let xk_Omacron             = 0x3d2
-let xk_Kcedilla            = 0x3d3
-let xk_Uogonek             = 0x3d9
-let xk_Utilde              = 0x3dd
-let xk_Umacron             = 0x3de
-let xk_amacron             = 0x3e0
-let xk_iogonek             = 0x3e7
-let xk_eabovedot           = 0x3ec
-let xk_imacron             = 0x3ef
-let xk_ncedilla            = 0x3f1
-let xk_omacron             = 0x3f2
-let xk_kcedilla            = 0x3f3
-let xk_uogonek             = 0x3f9
-let xk_utilde              = 0x3fd
-let xk_umacron             = 0x3fe
-
-
-(*
- * Katakana
- * Byte 3 = 4
- *)
-
-
-let xk_overline				       = 0x47e
-let xk_kana_fullstop                               = 0x4a1
-let xk_kana_openingbracket                         = 0x4a2
-let xk_kana_closingbracket                         = 0x4a3
-let xk_kana_comma                                  = 0x4a4
-let xk_kana_conjunctive                            = 0x4a5
-let xk_kana_middledot                              = 0x4a5  (** deprecated *)
-let xk_kana_WO                                     = 0x4a6
-let xk_kana_a                                      = 0x4a7
-let xk_kana_i                                      = 0x4a8
-let xk_kana_u                                      = 0x4a9
-let xk_kana_e                                      = 0x4aa
-let xk_kana_o                                      = 0x4ab
-let xk_kana_ya                                     = 0x4ac
-let xk_kana_yu                                     = 0x4ad
-let xk_kana_yo                                     = 0x4ae
-let xk_kana_tsu                                    = 0x4af
-let xk_kana_tu                                     = 0x4af  (** deprecated *)
-let xk_prolongedsound                              = 0x4b0
-let xk_kana_A                                      = 0x4b1
-let xk_kana_I                                      = 0x4b2
-let xk_kana_U                                      = 0x4b3
-let xk_kana_E                                      = 0x4b4
-let xk_kana_O                                      = 0x4b5
-let xk_kana_KA                                     = 0x4b6
-let xk_kana_KI                                     = 0x4b7
-let xk_kana_KU                                     = 0x4b8
-let xk_kana_KE                                     = 0x4b9
-let xk_kana_KO                                     = 0x4ba
-let xk_kana_SA                                     = 0x4bb
-let xk_kana_SHI                                    = 0x4bc
-let xk_kana_SU                                     = 0x4bd
-let xk_kana_SE                                     = 0x4be
-let xk_kana_SO                                     = 0x4bf
-let xk_kana_TA                                     = 0x4c0
-let xk_kana_CHI                                    = 0x4c1
-let xk_kana_TI                                     = 0x4c1  (** deprecated *)
-let xk_kana_TSU                                    = 0x4c2
-let xk_kana_TU                                     = 0x4c2  (** deprecated *)
-let xk_kana_TE                                     = 0x4c3
-let xk_kana_TO                                     = 0x4c4
-let xk_kana_NA                                     = 0x4c5
-let xk_kana_NI                                     = 0x4c6
-let xk_kana_NU                                     = 0x4c7
-let xk_kana_NE                                     = 0x4c8
-let xk_kana_NO                                     = 0x4c9
-let xk_kana_HA                                     = 0x4ca
-let xk_kana_HI                                     = 0x4cb
-let xk_kana_FU                                     = 0x4cc
-let xk_kana_HU                                     = 0x4cc  (** deprecated *)
-let xk_kana_HE                                     = 0x4cd
-let xk_kana_HO                                     = 0x4ce
-let xk_kana_MA                                     = 0x4cf
-let xk_kana_MI                                     = 0x4d0
-let xk_kana_MU                                     = 0x4d1
-let xk_kana_ME                                     = 0x4d2
-let xk_kana_MO                                     = 0x4d3
-let xk_kana_YA                                     = 0x4d4
-let xk_kana_YU                                     = 0x4d5
-let xk_kana_YO                                     = 0x4d6
-let xk_kana_RA                                     = 0x4d7
-let xk_kana_RI                                     = 0x4d8
-let xk_kana_RU                                     = 0x4d9
-let xk_kana_RE                                     = 0x4da
-let xk_kana_RO                                     = 0x4db
-let xk_kana_WA                                     = 0x4dc
-let xk_kana_N                                      = 0x4dd
-let xk_voicedsound                                 = 0x4de
-let xk_semivoicedsound                             = 0x4df
-let xk_kana_switch          = 0xFF7E  (** Alias for mode_switch *)
-
-
-(*
- *  Arabic
- *  Byte 3 = 5
- *)
-
-
-let xk_Arabic_comma                                = 0x5ac
-let xk_Arabic_semicolon                            = 0x5bb
-let xk_Arabic_question_mark                        = 0x5bf
-let xk_Arabic_hamza                                = 0x5c1
-let xk_Arabic_maddaonalef                          = 0x5c2
-let xk_Arabic_hamzaonalef                          = 0x5c3
-let xk_Arabic_hamzaonwaw                           = 0x5c4
-let xk_Arabic_hamzaunderalef                       = 0x5c5
-let xk_Arabic_hamzaonyeh                           = 0x5c6
-let xk_Arabic_alef                                 = 0x5c7
-let xk_Arabic_beh                                  = 0x5c8
-let xk_Arabic_tehmarbuta                           = 0x5c9
-let xk_Arabic_teh                                  = 0x5ca
-let xk_Arabic_theh                                 = 0x5cb
-let xk_Arabic_jeem                                 = 0x5cc
-let xk_Arabic_hah                                  = 0x5cd
-let xk_Arabic_khah                                 = 0x5ce
-let xk_Arabic_dal                                  = 0x5cf
-let xk_Arabic_thal                                 = 0x5d0
-let xk_Arabic_ra                                   = 0x5d1
-let xk_Arabic_zain                                 = 0x5d2
-let xk_Arabic_seen                                 = 0x5d3
-let xk_Arabic_sheen                                = 0x5d4
-let xk_Arabic_sad                                  = 0x5d5
-let xk_Arabic_dad                                  = 0x5d6
-let xk_Arabic_tah                                  = 0x5d7
-let xk_Arabic_zah                                  = 0x5d8
-let xk_Arabic_ain                                  = 0x5d9
-let xk_Arabic_ghain                                = 0x5da
-let xk_Arabic_tatweel                              = 0x5e0
-let xk_Arabic_feh                                  = 0x5e1
-let xk_Arabic_qaf                                  = 0x5e2
-let xk_Arabic_kaf                                  = 0x5e3
-let xk_Arabic_lam                                  = 0x5e4
-let xk_Arabic_meem                                 = 0x5e5
-let xk_Arabic_noon                                 = 0x5e6
-let xk_Arabic_ha                                   = 0x5e7
-let xk_Arabic_heh                                  = 0x5e7  (** deprecated *)
-let xk_Arabic_waw                                  = 0x5e8
-let xk_Arabic_alefmaksura                          = 0x5e9
-let xk_Arabic_yeh                                  = 0x5ea
-let xk_Arabic_fathatan                             = 0x5eb
-let xk_Arabic_dammatan                             = 0x5ec
-let xk_Arabic_kasratan                             = 0x5ed
-let xk_Arabic_fatha                                = 0x5ee
-let xk_Arabic_damma                                = 0x5ef
-let xk_Arabic_kasra                                = 0x5f0
-let xk_Arabic_shadda                               = 0x5f1
-let xk_Arabic_sukun                                = 0x5f2
-let xk_Arabic_switch        = 0xFF7E  (** Alias for mode_switch *)
-
-
-(*
- * Cyrillic
- * Byte 3 = 6
- *)
-
-let xk_Serbian_dje                                 = 0x6a1
-let xk_Macedonia_gje                               = 0x6a2
-let xk_Cyrillic_io                                 = 0x6a3
-let xk_Ukrainian_ie                                = 0x6a4
-let xk_Ukranian_je                                 = 0x6a4  (** deprecated *)
-let xk_Macedonia_dse                               = 0x6a5
-let xk_Ukrainian_i                                 = 0x6a6
-let xk_Ukranian_i                                  = 0x6a6  (** deprecated *)
-let xk_Ukrainian_yi                                = 0x6a7
-let xk_Ukranian_yi                                 = 0x6a7  (** deprecated *)
-let xk_Cyrillic_je                                 = 0x6a8
-let xk_Serbian_je                                  = 0x6a8  (** deprecated *)
-let xk_Cyrillic_lje                                = 0x6a9
-let xk_Serbian_lje                                 = 0x6a9  (** deprecated *)
-let xk_Cyrillic_nje                                = 0x6aa
-let xk_Serbian_nje                                 = 0x6aa  (** deprecated *)
-let xk_Serbian_tshe                                = 0x6ab
-let xk_Macedonia_kje                               = 0x6ac
-let xk_Byelorussian_shortu                         = 0x6ae
-let xk_Cyrillic_dzhe                               = 0x6af
-let xk_Serbian_dze                                 = 0x6af  (** deprecated *)
-let xk_numerosign                                  = 0x6b0
-let xk_Serbian_DJE                                 = 0x6b1
-let xk_Macedonia_GJE                               = 0x6b2
-let xk_Cyrillic_IO                                 = 0x6b3
-let xk_Ukrainian_IE                                = 0x6b4
-let xk_Ukranian_JE                                 = 0x6b4  (** deprecated *)
-let xk_Macedonia_DSE                               = 0x6b5
-let xk_Ukrainian_I                                 = 0x6b6
-let xk_Ukranian_I                                  = 0x6b6  (** deprecated *)
-let xk_Ukrainian_YI                                = 0x6b7
-let xk_Ukranian_YI                                 = 0x6b7  (** deprecated *)
-let xk_Cyrillic_JE                                 = 0x6b8
-let xk_Serbian_JE                                  = 0x6b8  (** deprecated *)
-let xk_Cyrillic_LJE                                = 0x6b9
-let xk_Serbian_LJE                                 = 0x6b9  (** deprecated *)
-let xk_Cyrillic_NJE                                = 0x6ba
-let xk_Serbian_NJE                                 = 0x6ba  (** deprecated *)
-let xk_Serbian_TSHE                                = 0x6bb
-let xk_Macedonia_KJE                               = 0x6bc
-let xk_Byelorussian_SHORTU                         = 0x6be
-let xk_Cyrillic_DZHE                               = 0x6bf
-let xk_Serbian_DZE                                 = 0x6bf  (** deprecated *)
-let xk_Cyrillic_yu                                 = 0x6c0
-let xk_Cyrillic_a                                  = 0x6c1
-let xk_Cyrillic_be                                 = 0x6c2
-let xk_Cyrillic_tse                                = 0x6c3
-let xk_Cyrillic_de                                 = 0x6c4
-let xk_Cyrillic_ie                                 = 0x6c5
-let xk_Cyrillic_ef                                 = 0x6c6
-let xk_Cyrillic_ghe                                = 0x6c7
-let xk_Cyrillic_ha                                 = 0x6c8
-let xk_Cyrillic_i                                  = 0x6c9
-let xk_Cyrillic_shorti                             = 0x6ca
-let xk_Cyrillic_ka                                 = 0x6cb
-let xk_Cyrillic_el                                 = 0x6cc
-let xk_Cyrillic_em                                 = 0x6cd
-let xk_Cyrillic_en                                 = 0x6ce
-let xk_Cyrillic_o                                  = 0x6cf
-let xk_Cyrillic_pe                                 = 0x6d0
-let xk_Cyrillic_ya                                 = 0x6d1
-let xk_Cyrillic_er                                 = 0x6d2
-let xk_Cyrillic_es                                 = 0x6d3
-let xk_Cyrillic_te                                 = 0x6d4
-let xk_Cyrillic_u                                  = 0x6d5
-let xk_Cyrillic_zhe                                = 0x6d6
-let xk_Cyrillic_ve                                 = 0x6d7
-let xk_Cyrillic_softsign                           = 0x6d8
-let xk_Cyrillic_yeru                               = 0x6d9
-let xk_Cyrillic_ze                                 = 0x6da
-let xk_Cyrillic_sha                                = 0x6db
-let xk_Cyrillic_e                                  = 0x6dc
-let xk_Cyrillic_shcha                              = 0x6dd
-let xk_Cyrillic_che                                = 0x6de
-let xk_Cyrillic_hardsign                           = 0x6df
-let xk_Cyrillic_YU                                 = 0x6e0
-let xk_Cyrillic_A                                  = 0x6e1
-let xk_Cyrillic_BE                                 = 0x6e2
-let xk_Cyrillic_TSE                                = 0x6e3
-let xk_Cyrillic_DE                                 = 0x6e4
-let xk_Cyrillic_IE                                 = 0x6e5
-let xk_Cyrillic_EF                                 = 0x6e6
-let xk_Cyrillic_GHE                                = 0x6e7
-let xk_Cyrillic_HA                                 = 0x6e8
-let xk_Cyrillic_I                                  = 0x6e9
-let xk_Cyrillic_SHORTI                             = 0x6ea
-let xk_Cyrillic_KA                                 = 0x6eb
-let xk_Cyrillic_EL                                 = 0x6ec
-let xk_Cyrillic_EM                                 = 0x6ed
-let xk_Cyrillic_EN                                 = 0x6ee
-let xk_Cyrillic_O                                  = 0x6ef
-let xk_Cyrillic_PE                                 = 0x6f0
-let xk_Cyrillic_YA                                 = 0x6f1
-let xk_Cyrillic_ER                                 = 0x6f2
-let xk_Cyrillic_ES                                 = 0x6f3
-let xk_Cyrillic_TE                                 = 0x6f4
-let xk_Cyrillic_U                                  = 0x6f5
-let xk_Cyrillic_ZHE                                = 0x6f6
-let xk_Cyrillic_VE                                 = 0x6f7
-let xk_Cyrillic_SOFTSIGN                           = 0x6f8
-let xk_Cyrillic_YERU                               = 0x6f9
-let xk_Cyrillic_ZE                                 = 0x6fa
-let xk_Cyrillic_SHA                                = 0x6fb
-let xk_Cyrillic_E                                  = 0x6fc
-let xk_Cyrillic_SHCHA                              = 0x6fd
-let xk_Cyrillic_CHE                                = 0x6fe
-let xk_Cyrillic_HARDSIGN                           = 0x6ff
-
-
-(*
- * Greek
- * Byte 3 = 7
- *)
-
-
-let xk_Greek_ALPHAaccent                           = 0x7a1
-let xk_Greek_EPSILONaccent                         = 0x7a2
-let xk_Greek_ETAaccent                             = 0x7a3
-let xk_Greek_IOTAaccent                            = 0x7a4
-let xk_Greek_IOTAdiaeresis                         = 0x7a5
-let xk_Greek_OMICRONaccent                         = 0x7a7
-let xk_Greek_UPSILONaccent                         = 0x7a8
-let xk_Greek_UPSILONdieresis                       = 0x7a9
-let xk_Greek_OMEGAaccent                           = 0x7ab
-let xk_Greek_accentdieresis                        = 0x7ae
-let xk_Greek_horizbar                              = 0x7af
-let xk_Greek_alphaaccent                           = 0x7b1
-let xk_Greek_epsilonaccent                         = 0x7b2
-let xk_Greek_etaaccent                             = 0x7b3
-let xk_Greek_iotaaccent                            = 0x7b4
-let xk_Greek_iotadieresis                          = 0x7b5
-let xk_Greek_iotaaccentdieresis                    = 0x7b6
-let xk_Greek_omicronaccent                         = 0x7b7
-let xk_Greek_upsilonaccent                         = 0x7b8
-let xk_Greek_upsilondieresis                       = 0x7b9
-let xk_Greek_upsilonaccentdieresis                 = 0x7ba
-let xk_Greek_omegaaccent                           = 0x7bb
-let xk_Greek_ALPHA                                 = 0x7c1
-let xk_Greek_BETA                                  = 0x7c2
-let xk_Greek_GAMMA                                 = 0x7c3
-let xk_Greek_DELTA                                 = 0x7c4
-let xk_Greek_EPSILON                               = 0x7c5
-let xk_Greek_ZETA                                  = 0x7c6
-let xk_Greek_ETA                                   = 0x7c7
-let xk_Greek_THETA                                 = 0x7c8
-let xk_Greek_IOTA                                  = 0x7c9
-let xk_Greek_KAPPA                                 = 0x7ca
-let xk_Greek_LAMDA                                 = 0x7cb
-let xk_Greek_LAMBDA                                = 0x7cb
-let xk_Greek_MU                                    = 0x7cc
-let xk_Greek_NU                                    = 0x7cd
-let xk_Greek_XI                                    = 0x7ce
-let xk_Greek_OMICRON                               = 0x7cf
-let xk_Greek_PI                                    = 0x7d0
-let xk_Greek_RHO                                   = 0x7d1
-let xk_Greek_SIGMA                                 = 0x7d2
-let xk_Greek_TAU                                   = 0x7d4
-let xk_Greek_UPSILON                               = 0x7d5
-let xk_Greek_PHI                                   = 0x7d6
-let xk_Greek_CHI                                   = 0x7d7
-let xk_Greek_PSI                                   = 0x7d8
-let xk_Greek_OMEGA                                 = 0x7d9
-let xk_Greek_alpha                                 = 0x7e1
-let xk_Greek_beta                                  = 0x7e2
-let xk_Greek_gamma                                 = 0x7e3
-let xk_Greek_delta                                 = 0x7e4
-let xk_Greek_epsilon                               = 0x7e5
-let xk_Greek_zeta                                  = 0x7e6
-let xk_Greek_eta                                   = 0x7e7
-let xk_Greek_theta                                 = 0x7e8
-let xk_Greek_iota                                  = 0x7e9
-let xk_Greek_kappa                                 = 0x7ea
-let xk_Greek_lamda                                 = 0x7eb
-let xk_Greek_lambda                                = 0x7eb
-let xk_Greek_mu                                    = 0x7ec
-let xk_Greek_nu                                    = 0x7ed
-let xk_Greek_xi                                    = 0x7ee
-let xk_Greek_omicron                               = 0x7ef
-let xk_Greek_pi                                    = 0x7f0
-let xk_Greek_rho                                   = 0x7f1
-let xk_Greek_sigma                                 = 0x7f2
-let xk_Greek_finalsmallsigma                       = 0x7f3
-let xk_Greek_tau                                   = 0x7f4
-let xk_Greek_upsilon                               = 0x7f5
-let xk_Greek_phi                                   = 0x7f6
-let xk_Greek_chi                                   = 0x7f7
-let xk_Greek_psi                                   = 0x7f8
-let xk_Greek_omega                                 = 0x7f9
-let xk_Greek_switch         = 0xFF7E  (** Alias for mode_switch *)
-
-
-(*
- * Technical
- * Byte 3 = 8
- *)
-
-
-let xk_leftradical                                 = 0x8a1
-let xk_topleftradical                              = 0x8a2
-let xk_horizconnector                              = 0x8a3
-let xk_topintegral                                 = 0x8a4
-let xk_botintegral                                 = 0x8a5
-let xk_vertconnector                               = 0x8a6
-let xk_topleftsqbracket                            = 0x8a7
-let xk_botleftsqbracket                            = 0x8a8
-let xk_toprightsqbracket                           = 0x8a9
-let xk_botrightsqbracket                           = 0x8aa
-let xk_topleftparens                               = 0x8ab
-let xk_botleftparens                               = 0x8ac
-let xk_toprightparens                              = 0x8ad
-let xk_botrightparens                              = 0x8ae
-let xk_leftmiddlecurlybrace                        = 0x8af
-let xk_rightmiddlecurlybrace                       = 0x8b0
-let xk_topleftsummation                            = 0x8b1
-let xk_botleftsummation                            = 0x8b2
-let xk_topvertsummationconnector                   = 0x8b3
-let xk_botvertsummationconnector                   = 0x8b4
-let xk_toprightsummation                           = 0x8b5
-let xk_botrightsummation                           = 0x8b6
-let xk_rightmiddlesummation                        = 0x8b7
-let xk_lessthanequal                               = 0x8bc
-let xk_notequal                                    = 0x8bd
-let xk_greaterthanequal                            = 0x8be
-let xk_integral                                    = 0x8bf
-let xk_therefore                                   = 0x8c0
-let xk_variation                                   = 0x8c1
-let xk_infinity                                    = 0x8c2
-let xk_nabla                                       = 0x8c5
-let xk_approximate                                 = 0x8c8
-let xk_similarequal                                = 0x8c9
-let xk_ifonlyif                                    = 0x8cd
-let xk_implies                                     = 0x8ce
-let xk_identical                                   = 0x8cf
-let xk_radical                                     = 0x8d6
-let xk_includedin                                  = 0x8da
-let xk_includes                                    = 0x8db
-let xk_intersection                                = 0x8dc
-let xk_union                                       = 0x8dd
-let xk_logicaland                                  = 0x8de
-let xk_logicalor                                   = 0x8df
-let xk_partialderivative                           = 0x8ef
-let xk_function                                    = 0x8f6
-let xk_leftarrow                                   = 0x8fb
-let xk_uparrow                                     = 0x8fc
-let xk_rightarrow                                  = 0x8fd
-let xk_downarrow                                   = 0x8fe
-
-
-(*
- *  Special
- *  Byte 3 = 9
- *)
-
-
-let xk_blank                                       = 0x9df
-let xk_soliddiamond                                = 0x9e0
-let xk_checkerboard                                = 0x9e1
-let xk_ht                                          = 0x9e2
-let xk_ff                                          = 0x9e3
-let xk_cr                                          = 0x9e4
-let xk_lf                                          = 0x9e5
-let xk_nl                                          = 0x9e8
-let xk_vt                                          = 0x9e9
-let xk_lowrightcorner                              = 0x9ea
-let xk_uprightcorner                               = 0x9eb
-let xk_upleftcorner                                = 0x9ec
-let xk_lowleftcorner                               = 0x9ed
-let xk_crossinglines                               = 0x9ee
-let xk_horizlinescan1                              = 0x9ef
-let xk_horizlinescan3                              = 0x9f0
-let xk_horizlinescan5                              = 0x9f1
-let xk_horizlinescan7                              = 0x9f2
-let xk_horizlinescan9                              = 0x9f3
-let xk_leftt                                       = 0x9f4
-let xk_rightt                                      = 0x9f5
-let xk_bott                                        = 0x9f6
-let xk_topt                                        = 0x9f7
-let xk_vertbar                                     = 0x9f8
-
-
-(*
- *  Publishing
- *  Byte 3 = a
- *)
-
-
-let xk_emspace                                     = 0xaa1
-let xk_enspace                                     = 0xaa2
-let xk_em3space                                    = 0xaa3
-let xk_em4space                                    = 0xaa4
-let xk_digitspace                                  = 0xaa5
-let xk_punctspace                                  = 0xaa6
-let xk_thinspace                                   = 0xaa7
-let xk_hairspace                                   = 0xaa8
-let xk_emdash                                      = 0xaa9
-let xk_endash                                      = 0xaaa
-let xk_signifblank                                 = 0xaac
-let xk_ellipsis                                    = 0xaae
-let xk_doubbaselinedot                             = 0xaaf
-let xk_onethird                                    = 0xab0
-let xk_twothirds                                   = 0xab1
-let xk_onefifth                                    = 0xab2
-let xk_twofifths                                   = 0xab3
-let xk_threefifths                                 = 0xab4
-let xk_fourfifths                                  = 0xab5
-let xk_onesixth                                    = 0xab6
-let xk_fivesixths                                  = 0xab7
-let xk_careof                                      = 0xab8
-let xk_figdash                                     = 0xabb
-let xk_leftanglebracket                            = 0xabc
-let xk_decimalpoint                                = 0xabd
-let xk_rightanglebracket                           = 0xabe
-let xk_marker                                      = 0xabf
-let xk_oneeighth                                   = 0xac3
-let xk_threeeighths                                = 0xac4
-let xk_fiveeighths                                 = 0xac5
-let xk_seveneighths                                = 0xac6
-let xk_trademark                                   = 0xac9
-let xk_signaturemark                               = 0xaca
-let xk_trademarkincircle                           = 0xacb
-let xk_leftopentriangle                            = 0xacc
-let xk_rightopentriangle                           = 0xacd
-let xk_emopencircle                                = 0xace
-let xk_emopenrectangle                             = 0xacf
-let xk_leftsinglequotemark                         = 0xad0
-let xk_rightsinglequotemark                        = 0xad1
-let xk_leftdoublequotemark                         = 0xad2
-let xk_rightdoublequotemark                        = 0xad3
-let xk_prescription                                = 0xad4
-let xk_minutes                                     = 0xad6
-let xk_seconds                                     = 0xad7
-let xk_latincross                                  = 0xad9
-let xk_hexagram                                    = 0xada
-let xk_filledrectbullet                            = 0xadb
-let xk_filledlefttribullet                         = 0xadc
-let xk_filledrighttribullet                        = 0xadd
-let xk_emfilledcircle                              = 0xade
-let xk_emfilledrect                                = 0xadf
-let xk_enopencircbullet                            = 0xae0
-let xk_enopensquarebullet                          = 0xae1
-let xk_openrectbullet                              = 0xae2
-let xk_opentribulletup                             = 0xae3
-let xk_opentribulletdown                           = 0xae4
-let xk_openstar                                    = 0xae5
-let xk_enfilledcircbullet                          = 0xae6
-let xk_enfilledsqbullet                            = 0xae7
-let xk_filledtribulletup                           = 0xae8
-let xk_filledtribulletdown                         = 0xae9
-let xk_leftpointer                                 = 0xaea
-let xk_rightpointer                                = 0xaeb
-let xk_club                                        = 0xaec
-let xk_diamond                                     = 0xaed
-let xk_heart                                       = 0xaee
-let xk_maltesecross                                = 0xaf0
-let xk_dagger                                      = 0xaf1
-let xk_doubledagger                                = 0xaf2
-let xk_checkmark                                   = 0xaf3
-let xk_ballotcross                                 = 0xaf4
-let xk_musicalsharp                                = 0xaf5
-let xk_musicalflat                                 = 0xaf6
-let xk_malesymbol                                  = 0xaf7
-let xk_femalesymbol                                = 0xaf8
-let xk_telephone                                   = 0xaf9
-let xk_telephonerecorder                           = 0xafa
-let xk_phonographcopyright                         = 0xafb
-let xk_caret                                       = 0xafc
-let xk_singlelowquotemark                          = 0xafd
-let xk_doublelowquotemark                          = 0xafe
-let xk_cursor                                      = 0xaff
-
-
-(*
- *  APL
- *  Byte 3 = b
- *)
-
-
-let xk_leftcaret                                   = 0xba3
-let xk_rightcaret                                  = 0xba6
-let xk_downcaret                                   = 0xba8
-let xk_upcaret                                     = 0xba9
-let xk_overbar                                     = 0xbc0
-let xk_downtack                                    = 0xbc2
-let xk_upshoe                                      = 0xbc3
-let xk_downstile                                   = 0xbc4
-let xk_underbar                                    = 0xbc6
-let xk_jot                                         = 0xbca
-let xk_quad                                        = 0xbcc
-let xk_uptack                                      = 0xbce
-let xk_circle                                      = 0xbcf
-let xk_upstile                                     = 0xbd3
-let xk_downshoe                                    = 0xbd6
-let xk_rightshoe                                   = 0xbd8
-let xk_leftshoe                                    = 0xbda
-let xk_lefttack                                    = 0xbdc
-let xk_righttack                                   = 0xbfc
-
-
-(*
- * Hebrew
- * Byte 3 = c
- *)
-
-
-let xk_hebrew_doublelowline                        = 0xcdf
-let xk_hebrew_aleph                                = 0xce0
-let xk_hebrew_bet                                  = 0xce1
-let xk_hebrew_beth                                 = 0xce1  (** deprecated *)
-let xk_hebrew_gimel                                = 0xce2
-let xk_hebrew_gimmel                               = 0xce2  (** deprecated *)
-let xk_hebrew_dalet                                = 0xce3
-let xk_hebrew_daleth                               = 0xce3  (** deprecated *)
-let xk_hebrew_he                                   = 0xce4
-let xk_hebrew_waw                                  = 0xce5
-let xk_hebrew_zain                                 = 0xce6
-let xk_hebrew_zayin                                = 0xce6  (** deprecated *)
-let xk_hebrew_chet                                 = 0xce7
-let xk_hebrew_het                                  = 0xce7  (** deprecated *)
-let xk_hebrew_tet                                  = 0xce8
-let xk_hebrew_teth                                 = 0xce8  (** deprecated *)
-let xk_hebrew_yod                                  = 0xce9
-let xk_hebrew_finalkaph                            = 0xcea
-let xk_hebrew_kaph                                 = 0xceb
-let xk_hebrew_lamed                                = 0xcec
-let xk_hebrew_finalmem                             = 0xced
-let xk_hebrew_mem                                  = 0xcee
-let xk_hebrew_finalnun                             = 0xcef
-let xk_hebrew_nun                                  = 0xcf0
-let xk_hebrew_samech                               = 0xcf1
-let xk_hebrew_samekh                               = 0xcf1  (** deprecated *)
-let xk_hebrew_ayin                                 = 0xcf2
-let xk_hebrew_finalpe                              = 0xcf3
-let xk_hebrew_pe                                   = 0xcf4
-let xk_hebrew_finalzade                            = 0xcf5
-let xk_hebrew_finalzadi                            = 0xcf5  (** deprecated *)
-let xk_hebrew_zade                                 = 0xcf6
-let xk_hebrew_zadi                                 = 0xcf6  (** deprecated *)
-let xk_hebrew_qoph                                 = 0xcf7
-let xk_hebrew_kuf                                  = 0xcf7  (** deprecated *)
-let xk_hebrew_resh                                 = 0xcf8
-let xk_hebrew_shin                                 = 0xcf9
-let xk_hebrew_taw                                  = 0xcfa
-let xk_hebrew_taf                                  = 0xcfa  (** deprecated *)
-let xk_Hebrew_switch        = 0xFF7E  (** Alias for mode_switch *)
-
-
-(*
- * Thai
- * Byte 3 = d
- *)
-
-
-let xk_Thai_kokai					= 0xda1
-let xk_Thai_khokhai					= 0xda2
-let xk_Thai_khokhuat				= 0xda3
-let xk_Thai_khokhwai				= 0xda4
-let xk_Thai_khokhon					= 0xda5
-let xk_Thai_khorakhang			        = 0xda6
-let xk_Thai_ngongu					= 0xda7
-let xk_Thai_chochan					= 0xda8
-let xk_Thai_choching				= 0xda9
-let xk_Thai_chochang				= 0xdaa
-let xk_Thai_soso					= 0xdab
-let xk_Thai_chochoe					= 0xdac
-let xk_Thai_yoying					= 0xdad
-let xk_Thai_dochada					= 0xdae
-let xk_Thai_topatak					= 0xdaf
-let xk_Thai_thothan					= 0xdb0
-let xk_Thai_thonangmontho			        = 0xdb1
-let xk_Thai_thophuthao			        = 0xdb2
-let xk_Thai_nonen					= 0xdb3
-let xk_Thai_dodek					= 0xdb4
-let xk_Thai_totao					= 0xdb5
-let xk_Thai_thothung				= 0xdb6
-let xk_Thai_thothahan				= 0xdb7
-let xk_Thai_thothong	 			= 0xdb8
-let xk_Thai_nonu					= 0xdb9
-let xk_Thai_bobaimai				= 0xdba
-let xk_Thai_popla					= 0xdbb
-let xk_Thai_phophung				= 0xdbc
-let xk_Thai_fofa					= 0xdbd
-let xk_Thai_phophan					= 0xdbe
-let xk_Thai_fofan					= 0xdbf
-let xk_Thai_phosamphao			        = 0xdc0
-let xk_Thai_moma					= 0xdc1
-let xk_Thai_yoyak					= 0xdc2
-let xk_Thai_rorua					= 0xdc3
-let xk_Thai_ru					= 0xdc4
-let xk_Thai_loling					= 0xdc5
-let xk_Thai_lu					= 0xdc6
-let xk_Thai_wowaen					= 0xdc7
-let xk_Thai_sosala					= 0xdc8
-let xk_Thai_sorusi					= 0xdc9
-let xk_Thai_sosua					= 0xdca
-let xk_Thai_hohip					= 0xdcb
-let xk_Thai_lochula					= 0xdcc
-let xk_Thai_oang					= 0xdcd
-let xk_Thai_honokhuk				= 0xdce
-let xk_Thai_paiyannoi				= 0xdcf
-let xk_Thai_saraa					= 0xdd0
-let xk_Thai_maihanakat				= 0xdd1
-let xk_Thai_saraaa					= 0xdd2
-let xk_Thai_saraam					= 0xdd3
-let xk_Thai_sarai					= 0xdd4
-let xk_Thai_saraii					= 0xdd5
-let xk_Thai_saraue					= 0xdd6
-let xk_Thai_sarauee					= 0xdd7
-let xk_Thai_sarau					= 0xdd8
-let xk_Thai_sarauu					= 0xdd9
-let xk_Thai_phinthu					= 0xdda
-let xk_Thai_maihanakat_maitho   			= 0xdde
-let xk_Thai_baht					= 0xddf
-let xk_Thai_sarae					= 0xde0
-let xk_Thai_saraae					= 0xde1
-let xk_Thai_sarao					= 0xde2
-let xk_Thai_saraaimaimuan				= 0xde3
-let xk_Thai_saraaimaimalai				= 0xde4
-let xk_Thai_lakkhangyao				= 0xde5
-let xk_Thai_maiyamok				= 0xde6
-let xk_Thai_maitaikhu				= 0xde7
-let xk_Thai_maiek					= 0xde8
-let xk_Thai_maitho					= 0xde9
-let xk_Thai_maitri					= 0xdea
-let xk_Thai_maichattawa				= 0xdeb
-let xk_Thai_thanthakhat				= 0xdec
-let xk_Thai_nikhahit				= 0xded
-let xk_Thai_leksun					= 0xdf0
-let xk_Thai_leknung					= 0xdf1
-let xk_Thai_leksong					= 0xdf2
-let xk_Thai_leksam					= 0xdf3
-let xk_Thai_leksi					= 0xdf4
-let xk_Thai_lekha					= 0xdf5
-let xk_Thai_lekhok					= 0xdf6
-let xk_Thai_lekchet					= 0xdf7
-let xk_Thai_lekpaet					= 0xdf8
-let xk_Thai_lekkao					= 0xdf9
-
-
-(*
- *   Korean
- *   Byte 3 = e
- *)
-
-
-
-let xk_Hangul		= 0xff31    (** Hangul start/stop(toggle) *)
-let xk_Hangul_Start		= 0xff32    (** Hangul start *)
-let xk_Hangul_End		= 0xff33    (** Hangul end, English start *)
-let xk_Hangul_Hanja		= 0xff34    (** Start Hangul->Hanja Conversion *)
-let xk_Hangul_Jamo		= 0xff35    (** Hangul Jamo mode *)
-let xk_Hangul_Romaja	= 0xff36    (** Hangul Romaja mode *)
-let xk_Hangul_Codeinput	= 0xff37    (** Hangul code input mode *)
-let xk_Hangul_Jeonja	= 0xff38    (** Jeonja mode *)
-let xk_Hangul_Banja		= 0xff39    (** Banja mode *)
-let xk_Hangul_PreHanja	= 0xff3a    (** Pre Hanja conversion *)
-let xk_Hangul_PostHanja	= 0xff3b    (** Post Hanja conversion *)
-let xk_Hangul_SingleCandidate	= 0xff3c    (** Single candidate *)
-let xk_Hangul_MultipleCandidate	= 0xff3d    (** Multiple candidate *)
-let xk_Hangul_PreviousCandidate	= 0xff3e    (** Previous candidate *)
-let xk_Hangul_Special	= 0xff3f    (** Special symbols *)
-let xk_Hangul_switch	= 0xFF7E    (** Alias for mode_switch *)
-
-(** Hangul Consonant Characters *)
-let xk_Hangul_Kiyeog				= 0xea1
-let xk_Hangul_SsangKiyeog				= 0xea2
-let xk_Hangul_KiyeogSios				= 0xea3
-let xk_Hangul_Nieun					= 0xea4
-let xk_Hangul_NieunJieuj				= 0xea5
-let xk_Hangul_NieunHieuh				= 0xea6
-let xk_Hangul_Dikeud				= 0xea7
-let xk_Hangul_SsangDikeud				= 0xea8
-let xk_Hangul_Rieul					= 0xea9
-let xk_Hangul_RieulKiyeog				= 0xeaa
-let xk_Hangul_RieulMieum				= 0xeab
-let xk_Hangul_RieulPieub				= 0xeac
-let xk_Hangul_RieulSios				= 0xead
-let xk_Hangul_RieulTieut				= 0xeae
-let xk_Hangul_RieulPhieuf				= 0xeaf
-let xk_Hangul_RieulHieuh				= 0xeb0
-let xk_Hangul_Mieum					= 0xeb1
-let xk_Hangul_Pieub					= 0xeb2
-let xk_Hangul_SsangPieub				= 0xeb3
-let xk_Hangul_PieubSios				= 0xeb4
-let xk_Hangul_Sios					= 0xeb5
-let xk_Hangul_SsangSios				= 0xeb6
-let xk_Hangul_Ieung					= 0xeb7
-let xk_Hangul_Jieuj					= 0xeb8
-let xk_Hangul_SsangJieuj				= 0xeb9
-let xk_Hangul_Cieuc					= 0xeba
-let xk_Hangul_Khieuq				= 0xebb
-let xk_Hangul_Tieut					= 0xebc
-let xk_Hangul_Phieuf				= 0xebd
-let xk_Hangul_Hieuh					= 0xebe
-
-(** Hangul Vowel Characters *)
-let xk_Hangul_A					= 0xebf
-let xk_Hangul_AE					= 0xec0
-let xk_Hangul_YA					= 0xec1
-let xk_Hangul_YAE					= 0xec2
-let xk_Hangul_EO					= 0xec3
-let xk_Hangul_E					= 0xec4
-let xk_Hangul_YEO					= 0xec5
-let xk_Hangul_YE					= 0xec6
-let xk_Hangul_O					= 0xec7
-let xk_Hangul_WA					= 0xec8
-let xk_Hangul_WAE					= 0xec9
-let xk_Hangul_OE					= 0xeca
-let xk_Hangul_YO					= 0xecb
-let xk_Hangul_U					= 0xecc
-let xk_Hangul_WEO					= 0xecd
-let xk_Hangul_WE					= 0xece
-let xk_Hangul_WI					= 0xecf
-let xk_Hangul_YU					= 0xed0
-let xk_Hangul_EU					= 0xed1
-let xk_Hangul_YI					= 0xed2
-let xk_Hangul_I					= 0xed3
-
-(** Hangul syllable-final (JongSeong) Characters *)
-let xk_Hangul_J_Kiyeog				= 0xed4
-let xk_Hangul_J_SsangKiyeog				= 0xed5
-let xk_Hangul_J_KiyeogSios				= 0xed6
-let xk_Hangul_J_Nieun				= 0xed7
-let xk_Hangul_J_NieunJieuj				= 0xed8
-let xk_Hangul_J_NieunHieuh				= 0xed9
-let xk_Hangul_J_Dikeud				= 0xeda
-let xk_Hangul_J_Rieul				= 0xedb
-let xk_Hangul_J_RieulKiyeog				= 0xedc
-let xk_Hangul_J_RieulMieum				= 0xedd
-let xk_Hangul_J_RieulPieub				= 0xede
-let xk_Hangul_J_RieulSios				= 0xedf
-let xk_Hangul_J_RieulTieut				= 0xee0
-let xk_Hangul_J_RieulPhieuf				= 0xee1
-let xk_Hangul_J_RieulHieuh				= 0xee2
-let xk_Hangul_J_Mieum				= 0xee3
-let xk_Hangul_J_Pieub				= 0xee4
-let xk_Hangul_J_PieubSios				= 0xee5
-let xk_Hangul_J_Sios				= 0xee6
-let xk_Hangul_J_SsangSios				= 0xee7
-let xk_Hangul_J_Ieung				= 0xee8
-let xk_Hangul_J_Jieuj				= 0xee9
-let xk_Hangul_J_Cieuc				= 0xeea
-let xk_Hangul_J_Khieuq				= 0xeeb
-let xk_Hangul_J_Tieut				= 0xeec
-let xk_Hangul_J_Phieuf				= 0xeed
-let xk_Hangul_J_Hieuh				= 0xeee
-
-(** Ancient Hangul Consonant Characters *)
-let xk_Hangul_RieulYeorinHieuh			= 0xeef
-let xk_Hangul_SunkyeongeumMieum			= 0xef0
-let xk_Hangul_SunkyeongeumPieub			= 0xef1
-let xk_Hangul_PanSios				= 0xef2
-let xk_Hangul_KkogjiDalrinIeung			= 0xef3
-let xk_Hangul_SunkyeongeumPhieuf			= 0xef4
-let xk_Hangul_YeorinHieuh				= 0xef5
-
-(** Ancient Hangul Vowel Characters *)
-let xk_Hangul_AraeA					= 0xef6
-let xk_Hangul_AraeAE				= 0xef7
-
-(** Ancient Hangul syllable-final (JongSeong) Characters *)
-let xk_Hangul_J_PanSios				= 0xef8
-let xk_Hangul_J_KkogjiDalrinIeung			= 0xef9
-let xk_Hangul_J_YeorinHieuh				= 0xefa
-
-(** Korean currency symbol *)
-let xk_Korean_Won					= 0xeff
-
-
-
-let name_to_keysym = [
-"VoidSymbol",0xFFFFFF;
-"BackSpace",0xFF08;
-"Tab",0xFF09;
-"Linefeed",0xFF0A;
-"Clear",0xFF0B;
-"Return",0xFF0D;
-"Pause",0xFF13;
-"Scroll_Lock",0xFF14;
-"Sys_Req",0xFF15;
-"Escape",0xFF1B;
-"Delete",0xFFFF;
-"Multi_key",0xFF20;
-"Kanji",0xFF21;
-"Muhenkan",0xFF22;
-"Henkan_Mode",0xFF23;
-"Henkan",0xFF23;
-"Romaji",0xFF24;
-"Hiragana",0xFF25;
-"Katakana",0xFF26;
-"Hiragana_Katakana",0xFF27;
-"Zenkaku",0xFF28;
-"Hankaku",0xFF29;
-"Zenkaku_Hankaku",0xFF2A;
-"Touroku",0xFF2B;
-"Massyo",0xFF2C;
-"Kana_Lock",0xFF2D;
-"Kana_Shift",0xFF2E;
-"Eisu_Shift",0xFF2F;
-"Eisu_toggle",0xFF30;
-"Home",0xFF50;
-"Left",0xFF51;
-"Up",0xFF52;
-"Right",0xFF53;
-"Down",0xFF54;
-"Prior",0xFF55;
-"Page_Up",0xFF55;
-"Next",0xFF56;
-"Page_Down",0xFF56;
-"End",0xFF57;
-"Begin",0xFF58;
-"Select",0xFF60;
-"Print",0xFF61;
-"Execute",0xFF62;
-"Insert",0xFF63;
-"Undo",0xFF65;
-"Redo",0xFF66;
-"Menu",0xFF67;
-"Find",0xFF68;
-"Cancel",0xFF69;
-"Help",0xFF6A;
-"Break",0xFF6B;
-"Mode_switch",0xFF7E;
-"script_switch",0xFF7E;
-"Num_Lock",0xFF7F;
-"KP_Space",0xFF80;
-"KP_Tab",0xFF89;
-"KP_Enter",0xFF8D;
-"KP_F1",0xFF91;
-"KP_F2",0xFF92;
-"KP_F3",0xFF93;
-"KP_F4",0xFF94;
-"KP_Home",0xFF95;
-"KP_Left",0xFF96;
-"KP_Up",0xFF97;
-"KP_Right",0xFF98;
-"KP_Down",0xFF99;
-"KP_Prior",0xFF9A;
-"KP_Page_Up",0xFF9A;
-"KP_Next",0xFF9B;
-"KP_Page_Down",0xFF9B;
-"KP_End",0xFF9C;
-"KP_Begin",0xFF9D;
-"KP_Insert",0xFF9E;
-"KP_Delete",0xFF9F;
-"KP_Equal",0xFFBD;
-"KP_Multiply",0xFFAA;
-"KP_Add",0xFFAB;
-"KP_Separator",0xFFAC;
-"KP_Subtract",0xFFAD;
-"KP_Decimal",0xFFAE;
-"KP_Divide",0xFFAF;
-"KP_0",0xFFB0;
-"KP_1",0xFFB1;
-"KP_2",0xFFB2;
-"KP_3",0xFFB3;
-"KP_4",0xFFB4;
-"KP_5",0xFFB5;
-"KP_6",0xFFB6;
-"KP_7",0xFFB7;
-"KP_8",0xFFB8;
-"KP_9",0xFFB9;
-"F1",0xFFBE;
-"F2",0xFFBF;
-"F3",0xFFC0;
-"F4",0xFFC1;
-"F5",0xFFC2;
-"F6",0xFFC3;
-"F7",0xFFC4;
-"F8",0xFFC5;
-"F9",0xFFC6;
-"F10",0xFFC7;
-"F11",0xFFC8;
-"L1",0xFFC8;
-"F12",0xFFC9;
-"L2",0xFFC9;
-"F13",0xFFCA;
-"L3",0xFFCA;
-"F14",0xFFCB;
-"L4",0xFFCB;
-"F15",0xFFCC;
-"L5",0xFFCC;
-"F16",0xFFCD;
-"L6",0xFFCD;
-"F17",0xFFCE;
-"L7",0xFFCE;
-"F18",0xFFCF;
-"L8",0xFFCF;
-"F19",0xFFD0;
-"L9",0xFFD0;
-"F20",0xFFD1;
-"L10",0xFFD1;
-"F21",0xFFD2;
-"R1",0xFFD2;
-"F22",0xFFD3;
-"R2",0xFFD3;
-"F23",0xFFD4;
-"R3",0xFFD4;
-"F24",0xFFD5;
-"R4",0xFFD5;
-"F25",0xFFD6;
-"R5",0xFFD6;
-"F26",0xFFD7;
-"R6",0xFFD7;
-"F27",0xFFD8;
-"R7",0xFFD8;
-"F28",0xFFD9;
-"R8",0xFFD9;
-"F29",0xFFDA;
-"R9",0xFFDA;
-"F30",0xFFDB;
-"R10",0xFFDB;
-"F31",0xFFDC;
-"R11",0xFFDC;
-"F32",0xFFDD;
-"R12",0xFFDD;
-"F33",0xFFDE;
-"R13",0xFFDE;
-"F34",0xFFDF;
-"R14",0xFFDF;
-"F35",0xFFE0;
-"R15",0xFFE0;
-"Shift_L",0xFFE1;
-"Shift_R",0xFFE2;
-"Control_L",0xFFE3;
-"Control_R",0xFFE4;
-"Caps_Lock",0xFFE5;
-"Shift_Lock",0xFFE6;
-"Meta_L",0xFFE7;
-"Meta_R",0xFFE8;
-"Alt_L",0xFFE9;
-"Alt_R",0xFFEA;
-"Super_L",0xFFEB;
-"Super_R",0xFFEC;
-"Hyper_L",0xFFED;
-"Hyper_R",0xFFEE;
-"ISO_Lock",0xFE01;
-"ISO_Level2_Latch",0xFE02;
-"ISO_Level3_Shift",0xFE03;
-"ISO_Level3_Latch",0xFE04;
-"ISO_Level3_Lock",0xFE05;
-"ISO_Group_Shift",0xFF7E;
-"ISO_Group_Latch",0xFE06;
-"ISO_Group_Lock",0xFE07;
-"ISO_Next_Group",0xFE08;
-"ISO_Next_Group_Lock",0xFE09;
-"ISO_Prev_Group",0xFE0A;
-"ISO_Prev_Group_Lock",0xFE0B;
-"ISO_First_Group",0xFE0C;
-"ISO_First_Group_Lock",0xFE0D;
-"ISO_Last_Group",0xFE0E;
-"ISO_Last_Group_Lock",0xFE0F;
-"ISO_Left_Tab",0xFE20;
-"ISO_Move_Line_Up",0xFE21;
-"ISO_Move_Line_Down",0xFE22;
-"ISO_Partial_Line_Up",0xFE23;
-"ISO_Partial_Line_Down",0xFE24;
-"ISO_Partial_Space_Left",0xFE25;
-"ISO_Partial_Space_Right",0xFE26;
-"ISO_Set_Margin_Left",0xFE27;
-"ISO_Set_Margin_Right",0xFE28;
-"ISO_Release_Margin_Left",0xFE29;
-"ISO_Release_Margin_Right",0xFE2A;
-"ISO_Release_Both_Margins",0xFE2B;
-"ISO_Fast_Cursor_Left",0xFE2C;
-"ISO_Fast_Cursor_Right",0xFE2D;
-"ISO_Fast_Cursor_Up",0xFE2E;
-"ISO_Fast_Cursor_Down",0xFE2F;
-"ISO_Continuous_Underline",0xFE30;
-"ISO_Discontinuous_Underline",0xFE31;
-"ISO_Emphasize",0xFE32;
-"ISO_Center_Object",0xFE33;
-"ISO_Enter",0xFE34;
-"dead_grave",0xFE50;
-"dead_acute",0xFE51;
-"dead_circumflex",0xFE52;
-"dead_tilde",0xFE53;
-"dead_macron",0xFE54;
-"dead_breve",0xFE55;
-"dead_abovedot",0xFE56;
-"dead_diaeresis",0xFE57;
-"dead_abovering",0xFE58;
-"dead_doubleacute",0xFE59;
-"dead_caron",0xFE5A;
-"dead_cedilla",0xFE5B;
-"dead_ogonek",0xFE5C;
-"dead_iota",0xFE5D;
-"dead_voiced_sound",0xFE5E;
-"dead_semivoiced_sound",0xFE5F;
-"dead_belowdot",0xFE60;
-"First_Virtual_Screen",0xFED0;
-"Prev_Virtual_Screen",0xFED1;
-"Next_Virtual_Screen",0xFED2;
-"Last_Virtual_Screen",0xFED4;
-"Terminate_Server",0xFED5;
-"AccessX_Enable",0xFE70;
-"AccessX_Feedback_Enable",0xFE71;
-"RepeatKeys_Enable",0xFE72;
-"SlowKeys_Enable",0xFE73;
-"BounceKeys_Enable",0xFE74;
-"StickyKeys_Enable",0xFE75;
-"MouseKeys_Enable",0xFE76;
-"MouseKeys_Accel_Enable",0xFE77;
-"Overlay1_Enable",0xFE78;
-"Overlay2_Enable",0xFE79;
-"AudibleBell_Enable",0xFE7A;
-"Pointer_Left",0xFEE0;
-"Pointer_Right",0xFEE1;
-"Pointer_Up",0xFEE2;
-"Pointer_Down",0xFEE3;
-"Pointer_UpLeft",0xFEE4;
-"Pointer_UpRight",0xFEE5;
-"Pointer_DownLeft",0xFEE6;
-"Pointer_DownRight",0xFEE7;
-"Pointer_Button_Dflt",0xFEE8;
-"Pointer_Button1",0xFEE9;
-"Pointer_Button2",0xFEEA;
-"Pointer_Button3",0xFEEB;
-"Pointer_Button4",0xFEEC;
-"Pointer_Button5",0xFEED;
-"Pointer_DblClick_Dflt",0xFEEE;
-"Pointer_DblClick1",0xFEEF;
-"Pointer_DblClick2",0xFEF0;
-"Pointer_DblClick3",0xFEF1;
-"Pointer_DblClick4",0xFEF2;
-"Pointer_DblClick5",0xFEF3;
-"Pointer_Drag_Dflt",0xFEF4;
-"Pointer_Drag1",0xFEF5;
-"Pointer_Drag2",0xFEF6;
-"Pointer_Drag3",0xFEF7;
-"Pointer_Drag4",0xFEF8;
-"Pointer_Drag5",0xFEFD;
-"Pointer_EnableKeys",0xFEF9;
-"Pointer_Accelerate",0xFEFA;
-"Pointer_DfltBtnNext",0xFEFB;
-"Pointer_DfltBtnPrev",0xFEFC;
-"3270_Duplicate",0xFD01;
-"3270_FieldMark",0xFD02;
-"3270_Right2",0xFD03;
-"3270_Left2",0xFD04;
-"3270_BackTab",0xFD05;
-"3270_EraseEOF",0xFD06;
-"3270_EraseInput",0xFD07;
-"3270_Reset",0xFD08;
-"3270_Quit",0xFD09;
-"3270_PA1",0xFD0A;
-"3270_PA2",0xFD0B;
-"3270_PA3",0xFD0C;
-"3270_Test",0xFD0D;
-"3270_Attn",0xFD0E;
-"3270_CursorBlink",0xFD0F;
-"3270_AltCursor",0xFD10;
-"3270_KeyClick",0xFD11;
-"3270_Jump",0xFD12;
-"3270_Ident",0xFD13;
-"3270_Rule",0xFD14;
-"3270_Copy",0xFD15;
-"3270_Play",0xFD16;
-"3270_Setup",0xFD17;
-"3270_Record",0xFD18;
-"3270_ChangeScreen",0xFD19;
-"3270_DeleteWord",0xFD1A;
-"3270_ExSelect",0xFD1B;
-"3270_CursorSelect",0xFD1C;
-"3270_PrintScreen",0xFD1D;
-"3270_Enter",0xFD1E;
-"space",0x020;
-"exclam",0x021;
-"quotedbl",0x022;
-"numbersign",0x023;
-"dollar",0x024;
-"percent",0x025;
-"ampersand",0x026;
-"apostrophe",0x027;
-"quoteright",0x027;
-"parenleft",0x028;
-"parenright",0x029;
-"asterisk",0x02a;
-"plus",0x02b;
-"comma",0x02c;
-"minus",0x02d;
-"period",0x02e;
-"slash",0x02f;
-"0",0x030;
-"1",0x031;
-"2",0x032;
-"3",0x033;
-"4",0x034;
-"5",0x035;
-"6",0x036;
-"7",0x037;
-"8",0x038;
-"9",0x039;
-"colon",0x03a;
-"semicolon",0x03b;
-"less",0x03c;
-"equal",0x03d;
-"greater",0x03e;
-"question",0x03f;
-"at",0x040;
-"A",0x041;
-"B",0x042;
-"C",0x043;
-"D",0x044;
-"E",0x045;
-"F",0x046;
-"G",0x047;
-"H",0x048;
-"I",0x049;
-"J",0x04a;
-"K",0x04b;
-"L",0x04c;
-"M",0x04d;
-"N",0x04e;
-"O",0x04f;
-"P",0x050;
-"Q",0x051;
-"R",0x052;
-"S",0x053;
-"T",0x054;
-"U",0x055;
-"V",0x056;
-"W",0x057;
-"X",0x058;
-"Y",0x059;
-"Z",0x05a;
-"bracketleft",0x05b;
-"backslash",0x05c;
-"bracketright",0x05d;
-"asciicircum",0x05e;
-"underscore",0x05f;
-"grave",0x060;
-"quoteleft",0x060;
-"a",0x061;
-"b",0x062;
-"c",0x063;
-"d",0x064;
-"e",0x065;
-"f",0x066;
-"g",0x067;
-"h",0x068;
-"i",0x069;
-"j",0x06a;
-"k",0x06b;
-"l",0x06c;
-"m",0x06d;
-"n",0x06e;
-"o",0x06f;
-"p",0x070;
-"q",0x071;
-"r",0x072;
-"s",0x073;
-"t",0x074;
-"u",0x075;
-"v",0x076;
-"w",0x077;
-"x",0x078;
-"y",0x079;
-"z",0x07a;
-"braceleft",0x07b;
-"bar",0x07c;
-"braceright",0x07d;
-"asciitilde",0x07e;
-"nobreakspace",0x0a0;
-"exclamdown",0x0a1;
-"cent",0x0a2;
-"sterling",0x0a3;
-"currency",0x0a4;
-"yen",0x0a5;
-"brokenbar",0x0a6;
-"section",0x0a7;
-"diaeresis",0x0a8;
-"copyright",0x0a9;
-"ordfeminine",0x0aa;
-"guillemotleft",0x0ab;
-"notsign",0x0ac;
-"hyphen",0x0ad;
-"registered",0x0ae;
-"macron",0x0af;
-"degree",0x0b0;
-"plusminus",0x0b1;
-"twosuperior",0x0b2;
-"threesuperior",0x0b3;
-"acute",0x0b4;
-"mu",0x0b5;
-"paragraph",0x0b6;
-"periodcentered",0x0b7;
-"cedilla",0x0b8;
-"onesuperior",0x0b9;
-"masculine",0x0ba;
-"guillemotright",0x0bb;
-"onequarter",0x0bc;
-"onehalf",0x0bd;
-"threequarters",0x0be;
-"questiondown",0x0bf;
-"Agrave",0x0c0;
-"Aacute",0x0c1;
-"Acircumflex",0x0c2;
-"Atilde",0x0c3;
-"Adiaeresis",0x0c4;
-"Aring",0x0c5;
-"AE",0x0c6;
-"Ccedilla",0x0c7;
-"Egrave",0x0c8;
-"Eacute",0x0c9;
-"Ecircumflex",0x0ca;
-"Ediaeresis",0x0cb;
-"Igrave",0x0cc;
-"Iacute",0x0cd;
-"Icircumflex",0x0ce;
-"Idiaeresis",0x0cf;
-"ETH",0x0d0;
-"Eth",0x0d0;
-"Ntilde",0x0d1;
-"Ograve",0x0d2;
-"Oacute",0x0d3;
-"Ocircumflex",0x0d4;
-"Otilde",0x0d5;
-"Odiaeresis",0x0d6;
-"multiply",0x0d7;
-"Ooblique",0x0d8;
-"Ugrave",0x0d9;
-"Uacute",0x0da;
-"Ucircumflex",0x0db;
-"Udiaeresis",0x0dc;
-"Yacute",0x0dd;
-"THORN",0x0de;
-"Thorn",0x0de;
-"ssharp",0x0df;
-"agrave",0x0e0;
-"aacute",0x0e1;
-"acircumflex",0x0e2;
-"atilde",0x0e3;
-"adiaeresis",0x0e4;
-"aring",0x0e5;
-"ae",0x0e6;
-"ccedilla",0x0e7;
-"egrave",0x0e8;
-"eacute",0x0e9;
-"ecircumflex",0x0ea;
-"ediaeresis",0x0eb;
-"igrave",0x0ec;
-"iacute",0x0ed;
-"icircumflex",0x0ee;
-"idiaeresis",0x0ef;
-"eth",0x0f0;
-"ntilde",0x0f1;
-"ograve",0x0f2;
-"oacute",0x0f3;
-"ocircumflex",0x0f4;
-"otilde",0x0f5;
-"odiaeresis",0x0f6;
-"division",0x0f7;
-"oslash",0x0f8;
-"ugrave",0x0f9;
-"uacute",0x0fa;
-"ucircumflex",0x0fb;
-"udiaeresis",0x0fc;
-"yacute",0x0fd;
-"thorn",0x0fe;
-"ydiaeresis",0x0ff;
-"Aogonek",0x1a1;
-"breve",0x1a2;
-"Lstroke",0x1a3;
-"Lcaron",0x1a5;
-"Sacute",0x1a6;
-"Scaron",0x1a9;
-"Scedilla",0x1aa;
-"Tcaron",0x1ab;
-"Zacute",0x1ac;
-"Zcaron",0x1ae;
-"Zabovedot",0x1af;
-"aogonek",0x1b1;
-"ogonek",0x1b2;
-"lstroke",0x1b3;
-"lcaron",0x1b5;
-"sacute",0x1b6;
-"caron",0x1b7;
-"scaron",0x1b9;
-"scedilla",0x1ba;
-"tcaron",0x1bb;
-"zacute",0x1bc;
-"doubleacute",0x1bd;
-"zcaron",0x1be;
-"zabovedot",0x1bf;
-"Racute",0x1c0;
-"Abreve",0x1c3;
-"Lacute",0x1c5;
-"Cacute",0x1c6;
-"Ccaron",0x1c8;
-"Eogonek",0x1ca;
-"Ecaron",0x1cc;
-"Dcaron",0x1cf;
-"Dstroke",0x1d0;
-"Nacute",0x1d1;
-"Ncaron",0x1d2;
-"Odoubleacute",0x1d5;
-"Rcaron",0x1d8;
-"Uring",0x1d9;
-"Udoubleacute",0x1db;
-"Tcedilla",0x1de;
-"racute",0x1e0;
-"abreve",0x1e3;
-"lacute",0x1e5;
-"cacute",0x1e6;
-"ccaron",0x1e8;
-"eogonek",0x1ea;
-"ecaron",0x1ec;
-"dcaron",0x1ef;
-"dstroke",0x1f0;
-"nacute",0x1f1;
-"ncaron",0x1f2;
-"odoubleacute",0x1f5;
-"udoubleacute",0x1fb;
-"rcaron",0x1f8;
-"uring",0x1f9;
-"tcedilla",0x1fe;
-"abovedot",0x1ff;
-"Hstroke",0x2a1;
-"Hcircumflex",0x2a6;
-"Iabovedot",0x2a9;
-"Gbreve",0x2ab;
-"Jcircumflex",0x2ac;
-"hstroke",0x2b1;
-"hcircumflex",0x2b6;
-"idotless",0x2b9;
-"gbreve",0x2bb;
-"jcircumflex",0x2bc;
-"Cabovedot",0x2c5;
-"Ccircumflex",0x2c6;
-"Gabovedot",0x2d5;
-"Gcircumflex",0x2d8;
-"Ubreve",0x2dd;
-"Scircumflex",0x2de;
-"cabovedot",0x2e5;
-"ccircumflex",0x2e6;
-"gabovedot",0x2f5;
-"gcircumflex",0x2f8;
-"ubreve",0x2fd;
-"scircumflex",0x2fe;
-"kra",0x3a2;
-"kappa",0x3a2;
-"Rcedilla",0x3a3;
-"Itilde",0x3a5;
-"Lcedilla",0x3a6;
-"Emacron",0x3aa;
-"Gcedilla",0x3ab;
-"Tslash",0x3ac;
-"rcedilla",0x3b3;
-"itilde",0x3b5;
-"lcedilla",0x3b6;
-"emacron",0x3ba;
-"gcedilla",0x3bb;
-"tslash",0x3bc;
-"ENG",0x3bd;
-"eng",0x3bf;
-"Amacron",0x3c0;
-"Iogonek",0x3c7;
-"Eabovedot",0x3cc;
-"Imacron",0x3cf;
-"Ncedilla",0x3d1;
-"Omacron",0x3d2;
-"Kcedilla",0x3d3;
-"Uogonek",0x3d9;
-"Utilde",0x3dd;
-"Umacron",0x3de;
-"amacron",0x3e0;
-"iogonek",0x3e7;
-"eabovedot",0x3ec;
-"imacron",0x3ef;
-"ncedilla",0x3f1;
-"omacron",0x3f2;
-"kcedilla",0x3f3;
-"uogonek",0x3f9;
-"utilde",0x3fd;
-"umacron",0x3fe;
-"overline",0x47e;
-"kana_fullstop",0x4a1;
-"kana_openingbracket",0x4a2;
-"kana_closingbracket",0x4a3;
-"kana_comma",0x4a4;
-"kana_conjunctive",0x4a5;
-"kana_middledot",0x4a5;
-"kana_WO",0x4a6;
-"kana_a",0x4a7;
-"kana_i",0x4a8;
-"kana_u",0x4a9;
-"kana_e",0x4aa;
-"kana_o",0x4ab;
-"kana_ya",0x4ac;
-"kana_yu",0x4ad;
-"kana_yo",0x4ae;
-"kana_tsu",0x4af;
-"kana_tu",0x4af;
-"prolongedsound",0x4b0;
-"kana_A",0x4b1;
-"kana_I",0x4b2;
-"kana_U",0x4b3;
-"kana_E",0x4b4;
-"kana_O",0x4b5;
-"kana_KA",0x4b6;
-"kana_KI",0x4b7;
-"kana_KU",0x4b8;
-"kana_KE",0x4b9;
-"kana_KO",0x4ba;
-"kana_SA",0x4bb;
-"kana_SHI",0x4bc;
-"kana_SU",0x4bd;
-"kana_SE",0x4be;
-"kana_SO",0x4bf;
-"kana_TA",0x4c0;
-"kana_CHI",0x4c1;
-"kana_TI",0x4c1;
-"kana_TSU",0x4c2;
-"kana_TU",0x4c2;
-"kana_TE",0x4c3;
-"kana_TO",0x4c4;
-"kana_NA",0x4c5;
-"kana_NI",0x4c6;
-"kana_NU",0x4c7;
-"kana_NE",0x4c8;
-"kana_NO",0x4c9;
-"kana_HA",0x4ca;
-"kana_HI",0x4cb;
-"kana_FU",0x4cc;
-"kana_HU",0x4cc;
-"kana_HE",0x4cd;
-"kana_HO",0x4ce;
-"kana_MA",0x4cf;
-"kana_MI",0x4d0;
-"kana_MU",0x4d1;
-"kana_ME",0x4d2;
-"kana_MO",0x4d3;
-"kana_YA",0x4d4;
-"kana_YU",0x4d5;
-"kana_YO",0x4d6;
-"kana_RA",0x4d7;
-"kana_RI",0x4d8;
-"kana_RU",0x4d9;
-"kana_RE",0x4da;
-"kana_RO",0x4db;
-"kana_WA",0x4dc;
-"kana_N",0x4dd;
-"voicedsound",0x4de;
-"semivoicedsound",0x4df;
-"kana_switch",0xFF7E;
-"Arabic_comma",0x5ac;
-"Arabic_semicolon",0x5bb;
-"Arabic_question_mark",0x5bf;
-"Arabic_hamza",0x5c1;
-"Arabic_maddaonalef",0x5c2;
-"Arabic_hamzaonalef",0x5c3;
-"Arabic_hamzaonwaw",0x5c4;
-"Arabic_hamzaunderalef",0x5c5;
-"Arabic_hamzaonyeh",0x5c6;
-"Arabic_alef",0x5c7;
-"Arabic_beh",0x5c8;
-"Arabic_tehmarbuta",0x5c9;
-"Arabic_teh",0x5ca;
-"Arabic_theh",0x5cb;
-"Arabic_jeem",0x5cc;
-"Arabic_hah",0x5cd;
-"Arabic_khah",0x5ce;
-"Arabic_dal",0x5cf;
-"Arabic_thal",0x5d0;
-"Arabic_ra",0x5d1;
-"Arabic_zain",0x5d2;
-"Arabic_seen",0x5d3;
-"Arabic_sheen",0x5d4;
-"Arabic_sad",0x5d5;
-"Arabic_dad",0x5d6;
-"Arabic_tah",0x5d7;
-"Arabic_zah",0x5d8;
-"Arabic_ain",0x5d9;
-"Arabic_ghain",0x5da;
-"Arabic_tatweel",0x5e0;
-"Arabic_feh",0x5e1;
-"Arabic_qaf",0x5e2;
-"Arabic_kaf",0x5e3;
-"Arabic_lam",0x5e4;
-"Arabic_meem",0x5e5;
-"Arabic_noon",0x5e6;
-"Arabic_ha",0x5e7;
-"Arabic_heh",0x5e7;
-"Arabic_waw",0x5e8;
-"Arabic_alefmaksura",0x5e9;
-"Arabic_yeh",0x5ea;
-"Arabic_fathatan",0x5eb;
-"Arabic_dammatan",0x5ec;
-"Arabic_kasratan",0x5ed;
-"Arabic_fatha",0x5ee;
-"Arabic_damma",0x5ef;
-"Arabic_kasra",0x5f0;
-"Arabic_shadda",0x5f1;
-"Arabic_sukun",0x5f2;
-"Arabic_switch",0xFF7E;
-"Serbian_dje",0x6a1;
-"Macedonia_gje",0x6a2;
-"Cyrillic_io",0x6a3;
-"Ukrainian_ie",0x6a4;
-"Ukranian_je",0x6a4;
-"Macedonia_dse",0x6a5;
-"Ukrainian_i",0x6a6;
-"Ukranian_i",0x6a6;
-"Ukrainian_yi",0x6a7;
-"Ukranian_yi",0x6a7;
-"Cyrillic_je",0x6a8;
-"Serbian_je",0x6a8;
-"Cyrillic_lje",0x6a9;
-"Serbian_lje",0x6a9;
-"Cyrillic_nje",0x6aa;
-"Serbian_nje",0x6aa;
-"Serbian_tshe",0x6ab;
-"Macedonia_kje",0x6ac;
-"Byelorussian_shortu",0x6ae;
-"Cyrillic_dzhe",0x6af;
-"Serbian_dze",0x6af;
-"numerosign",0x6b0;
-"Serbian_DJE",0x6b1;
-"Macedonia_GJE",0x6b2;
-"Cyrillic_IO",0x6b3;
-"Ukrainian_IE",0x6b4;
-"Ukranian_JE",0x6b4;
-"Macedonia_DSE",0x6b5;
-"Ukrainian_I",0x6b6;
-"Ukranian_I",0x6b6;
-"Ukrainian_YI",0x6b7;
-"Ukranian_YI",0x6b7;
-"Cyrillic_JE",0x6b8;
-"Serbian_JE",0x6b8;
-"Cyrillic_LJE",0x6b9;
-"Serbian_LJE",0x6b9;
-"Cyrillic_NJE",0x6ba;
-"Serbian_NJE",0x6ba;
-"Serbian_TSHE",0x6bb;
-"Macedonia_KJE",0x6bc;
-"Byelorussian_SHORTU",0x6be;
-"Cyrillic_DZHE",0x6bf;
-"Serbian_DZE",0x6bf;
-"Cyrillic_yu",0x6c0;
-"Cyrillic_a",0x6c1;
-"Cyrillic_be",0x6c2;
-"Cyrillic_tse",0x6c3;
-"Cyrillic_de",0x6c4;
-"Cyrillic_ie",0x6c5;
-"Cyrillic_ef",0x6c6;
-"Cyrillic_ghe",0x6c7;
-"Cyrillic_ha",0x6c8;
-"Cyrillic_i",0x6c9;
-"Cyrillic_shorti",0x6ca;
-"Cyrillic_ka",0x6cb;
-"Cyrillic_el",0x6cc;
-"Cyrillic_em",0x6cd;
-"Cyrillic_en",0x6ce;
-"Cyrillic_o",0x6cf;
-"Cyrillic_pe",0x6d0;
-"Cyrillic_ya",0x6d1;
-"Cyrillic_er",0x6d2;
-"Cyrillic_es",0x6d3;
-"Cyrillic_te",0x6d4;
-"Cyrillic_u",0x6d5;
-"Cyrillic_zhe",0x6d6;
-"Cyrillic_ve",0x6d7;
-"Cyrillic_softsign",0x6d8;
-"Cyrillic_yeru",0x6d9;
-"Cyrillic_ze",0x6da;
-"Cyrillic_sha",0x6db;
-"Cyrillic_e",0x6dc;
-"Cyrillic_shcha",0x6dd;
-"Cyrillic_che",0x6de;
-"Cyrillic_hardsign",0x6df;
-"Cyrillic_YU",0x6e0;
-"Cyrillic_A",0x6e1;
-"Cyrillic_BE",0x6e2;
-"Cyrillic_TSE",0x6e3;
-"Cyrillic_DE",0x6e4;
-"Cyrillic_IE",0x6e5;
-"Cyrillic_EF",0x6e6;
-"Cyrillic_GHE",0x6e7;
-"Cyrillic_HA",0x6e8;
-"Cyrillic_I",0x6e9;
-"Cyrillic_SHORTI",0x6ea;
-"Cyrillic_KA",0x6eb;
-"Cyrillic_EL",0x6ec;
-"Cyrillic_EM",0x6ed;
-"Cyrillic_EN",0x6ee;
-"Cyrillic_O",0x6ef;
-"Cyrillic_PE",0x6f0;
-"Cyrillic_YA",0x6f1;
-"Cyrillic_ER",0x6f2;
-"Cyrillic_ES",0x6f3;
-"Cyrillic_TE",0x6f4;
-"Cyrillic_U",0x6f5;
-"Cyrillic_ZHE",0x6f6;
-"Cyrillic_VE",0x6f7;
-"Cyrillic_SOFTSIGN",0x6f8;
-"Cyrillic_YERU",0x6f9;
-"Cyrillic_ZE",0x6fa;
-"Cyrillic_SHA",0x6fb;
-"Cyrillic_E",0x6fc;
-"Cyrillic_SHCHA",0x6fd;
-"Cyrillic_CHE",0x6fe;
-"Cyrillic_HARDSIGN",0x6ff;
-"Greek_ALPHAaccent",0x7a1;
-"Greek_EPSILONaccent",0x7a2;
-"Greek_ETAaccent",0x7a3;
-"Greek_IOTAaccent",0x7a4;
-"Greek_IOTAdiaeresis",0x7a5;
-"Greek_OMICRONaccent",0x7a7;
-"Greek_UPSILONaccent",0x7a8;
-"Greek_UPSILONdieresis",0x7a9;
-"Greek_OMEGAaccent",0x7ab;
-"Greek_accentdieresis",0x7ae;
-"Greek_horizbar",0x7af;
-"Greek_alphaaccent",0x7b1;
-"Greek_epsilonaccent",0x7b2;
-"Greek_etaaccent",0x7b3;
-"Greek_iotaaccent",0x7b4;
-"Greek_iotadieresis",0x7b5;
-"Greek_iotaaccentdieresis",0x7b6;
-"Greek_omicronaccent",0x7b7;
-"Greek_upsilonaccent",0x7b8;
-"Greek_upsilondieresis",0x7b9;
-"Greek_upsilonaccentdieresis",0x7ba;
-"Greek_omegaaccent",0x7bb;
-"Greek_ALPHA",0x7c1;
-"Greek_BETA",0x7c2;
-"Greek_GAMMA",0x7c3;
-"Greek_DELTA",0x7c4;
-"Greek_EPSILON",0x7c5;
-"Greek_ZETA",0x7c6;
-"Greek_ETA",0x7c7;
-"Greek_THETA",0x7c8;
-"Greek_IOTA",0x7c9;
-"Greek_KAPPA",0x7ca;
-"Greek_LAMDA",0x7cb;
-"Greek_LAMBDA",0x7cb;
-"Greek_MU",0x7cc;
-"Greek_NU",0x7cd;
-"Greek_XI",0x7ce;
-"Greek_OMICRON",0x7cf;
-"Greek_PI",0x7d0;
-"Greek_RHO",0x7d1;
-"Greek_SIGMA",0x7d2;
-"Greek_TAU",0x7d4;
-"Greek_UPSILON",0x7d5;
-"Greek_PHI",0x7d6;
-"Greek_CHI",0x7d7;
-"Greek_PSI",0x7d8;
-"Greek_OMEGA",0x7d9;
-"Greek_alpha",0x7e1;
-"Greek_beta",0x7e2;
-"Greek_gamma",0x7e3;
-"Greek_delta",0x7e4;
-"Greek_epsilon",0x7e5;
-"Greek_zeta",0x7e6;
-"Greek_eta",0x7e7;
-"Greek_theta",0x7e8;
-"Greek_iota",0x7e9;
-"Greek_kappa",0x7ea;
-"Greek_lamda",0x7eb;
-"Greek_lambda",0x7eb;
-"Greek_mu",0x7ec;
-"Greek_nu",0x7ed;
-"Greek_xi",0x7ee;
-"Greek_omicron",0x7ef;
-"Greek_pi",0x7f0;
-"Greek_rho",0x7f1;
-"Greek_sigma",0x7f2;
-"Greek_finalsmallsigma",0x7f3;
-"Greek_tau",0x7f4;
-"Greek_upsilon",0x7f5;
-"Greek_phi",0x7f6;
-"Greek_chi",0x7f7;
-"Greek_psi",0x7f8;
-"Greek_omega",0x7f9;
-"Greek_switch",0xFF7E;
-"leftradical",0x8a1;
-"topleftradical",0x8a2;
-"horizconnector",0x8a3;
-"topintegral",0x8a4;
-"botintegral",0x8a5;
-"vertconnector",0x8a6;
-"topleftsqbracket",0x8a7;
-"botleftsqbracket",0x8a8;
-"toprightsqbracket",0x8a9;
-"botrightsqbracket",0x8aa;
-"topleftparens",0x8ab;
-"botleftparens",0x8ac;
-"toprightparens",0x8ad;
-"botrightparens",0x8ae;
-"leftmiddlecurlybrace",0x8af;
-"rightmiddlecurlybrace",0x8b0;
-"topleftsummation",0x8b1;
-"botleftsummation",0x8b2;
-"topvertsummationconnector",0x8b3;
-"botvertsummationconnector",0x8b4;
-"toprightsummation",0x8b5;
-"botrightsummation",0x8b6;
-"rightmiddlesummation",0x8b7;
-"lessthanequal",0x8bc;
-"notequal",0x8bd;
-"greaterthanequal",0x8be;
-"integral",0x8bf;
-"therefore",0x8c0;
-"variation",0x8c1;
-"infinity",0x8c2;
-"nabla",0x8c5;
-"approximate",0x8c8;
-"similarequal",0x8c9;
-"ifonlyif",0x8cd;
-"implies",0x8ce;
-"identical",0x8cf;
-"radical",0x8d6;
-"includedin",0x8da;
-"includes",0x8db;
-"intersection",0x8dc;
-"union",0x8dd;
-"logicaland",0x8de;
-"logicalor",0x8df;
-"partialderivative",0x8ef;
-"function",0x8f6;
-"leftarrow",0x8fb;
-"uparrow",0x8fc;
-"rightarrow",0x8fd;
-"downarrow",0x8fe;
-"blank",0x9df;
-"soliddiamond",0x9e0;
-"checkerboard",0x9e1;
-"ht",0x9e2;
-"ff",0x9e3;
-"cr",0x9e4;
-"lf",0x9e5;
-"nl",0x9e8;
-"vt",0x9e9;
-"lowrightcorner",0x9ea;
-"uprightcorner",0x9eb;
-"upleftcorner",0x9ec;
-"lowleftcorner",0x9ed;
-"crossinglines",0x9ee;
-"horizlinescan1",0x9ef;
-"horizlinescan3",0x9f0;
-"horizlinescan5",0x9f1;
-"horizlinescan7",0x9f2;
-"horizlinescan9",0x9f3;
-"leftt",0x9f4;
-"rightt",0x9f5;
-"bott",0x9f6;
-"topt",0x9f7;
-"vertbar",0x9f8;
-"emspace",0xaa1;
-"enspace",0xaa2;
-"em3space",0xaa3;
-"em4space",0xaa4;
-"digitspace",0xaa5;
-"punctspace",0xaa6;
-"thinspace",0xaa7;
-"hairspace",0xaa8;
-"emdash",0xaa9;
-"endash",0xaaa;
-"signifblank",0xaac;
-"ellipsis",0xaae;
-"doubbaselinedot",0xaaf;
-"onethird",0xab0;
-"twothirds",0xab1;
-"onefifth",0xab2;
-"twofifths",0xab3;
-"threefifths",0xab4;
-"fourfifths",0xab5;
-"onesixth",0xab6;
-"fivesixths",0xab7;
-"careof",0xab8;
-"figdash",0xabb;
-"leftanglebracket",0xabc;
-"decimalpoint",0xabd;
-"rightanglebracket",0xabe;
-"marker",0xabf;
-"oneeighth",0xac3;
-"threeeighths",0xac4;
-"fiveeighths",0xac5;
-"seveneighths",0xac6;
-"trademark",0xac9;
-"signaturemark",0xaca;
-"trademarkincircle",0xacb;
-"leftopentriangle",0xacc;
-"rightopentriangle",0xacd;
-"emopencircle",0xace;
-"emopenrectangle",0xacf;
-"leftsinglequotemark",0xad0;
-"rightsinglequotemark",0xad1;
-"leftdoublequotemark",0xad2;
-"rightdoublequotemark",0xad3;
-"prescription",0xad4;
-"minutes",0xad6;
-"seconds",0xad7;
-"latincross",0xad9;
-"hexagram",0xada;
-"filledrectbullet",0xadb;
-"filledlefttribullet",0xadc;
-"filledrighttribullet",0xadd;
-"emfilledcircle",0xade;
-"emfilledrect",0xadf;
-"enopencircbullet",0xae0;
-"enopensquarebullet",0xae1;
-"openrectbullet",0xae2;
-"opentribulletup",0xae3;
-"opentribulletdown",0xae4;
-"openstar",0xae5;
-"enfilledcircbullet",0xae6;
-"enfilledsqbullet",0xae7;
-"filledtribulletup",0xae8;
-"filledtribulletdown",0xae9;
-"leftpointer",0xaea;
-"rightpointer",0xaeb;
-"club",0xaec;
-"diamond",0xaed;
-"heart",0xaee;
-"maltesecross",0xaf0;
-"dagger",0xaf1;
-"doubledagger",0xaf2;
-"checkmark",0xaf3;
-"ballotcross",0xaf4;
-"musicalsharp",0xaf5;
-"musicalflat",0xaf6;
-"malesymbol",0xaf7;
-"femalesymbol",0xaf8;
-"telephone",0xaf9;
-"telephonerecorder",0xafa;
-"phonographcopyright",0xafb;
-"caret",0xafc;
-"singlelowquotemark",0xafd;
-"doublelowquotemark",0xafe;
-"cursor",0xaff;
-"leftcaret",0xba3;
-"rightcaret",0xba6;
-"downcaret",0xba8;
-"upcaret",0xba9;
-"overbar",0xbc0;
-"downtack",0xbc2;
-"upshoe",0xbc3;
-"downstile",0xbc4;
-"underbar",0xbc6;
-"jot",0xbca;
-"quad",0xbcc;
-"uptack",0xbce;
-"circle",0xbcf;
-"upstile",0xbd3;
-"downshoe",0xbd6;
-"rightshoe",0xbd8;
-"leftshoe",0xbda;
-"lefttack",0xbdc;
-"righttack",0xbfc;
-"hebrew_doublelowline",0xcdf;
-"hebrew_aleph",0xce0;
-"hebrew_bet",0xce1;
-"hebrew_beth",0xce1;
-"hebrew_gimel",0xce2;
-"hebrew_gimmel",0xce2;
-"hebrew_dalet",0xce3;
-"hebrew_daleth",0xce3;
-"hebrew_he",0xce4;
-"hebrew_waw",0xce5;
-"hebrew_zain",0xce6;
-"hebrew_zayin",0xce6;
-"hebrew_chet",0xce7;
-"hebrew_het",0xce7;
-"hebrew_tet",0xce8;
-"hebrew_teth",0xce8;
-"hebrew_yod",0xce9;
-"hebrew_finalkaph",0xcea;
-"hebrew_kaph",0xceb;
-"hebrew_lamed",0xcec;
-"hebrew_finalmem",0xced;
-"hebrew_mem",0xcee;
-"hebrew_finalnun",0xcef;
-"hebrew_nun",0xcf0;
-"hebrew_samech",0xcf1;
-"hebrew_samekh",0xcf1;
-"hebrew_ayin",0xcf2;
-"hebrew_finalpe",0xcf3;
-"hebrew_pe",0xcf4;
-"hebrew_finalzade",0xcf5;
-"hebrew_finalzadi",0xcf5;
-"hebrew_zade",0xcf6;
-"hebrew_zadi",0xcf6;
-"hebrew_qoph",0xcf7;
-"hebrew_kuf",0xcf7;
-"hebrew_resh",0xcf8;
-"hebrew_shin",0xcf9;
-"hebrew_taw",0xcfa;
-"hebrew_taf",0xcfa;
-"Hebrew_switch",0xFF7E;
-"Thai_kokai",0xda1;
-"Thai_khokhai",0xda2;
-"Thai_khokhuat",0xda3;
-"Thai_khokhwai",0xda4;
-"Thai_khokhon",0xda5;
-"Thai_khorakhang",0xda6;
-"Thai_ngongu",0xda7;
-"Thai_chochan",0xda8;
-"Thai_choching",0xda9;
-"Thai_chochang",0xdaa;
-"Thai_soso",0xdab;
-"Thai_chochoe",0xdac;
-"Thai_yoying",0xdad;
-"Thai_dochada",0xdae;
-"Thai_topatak",0xdaf;
-"Thai_thothan",0xdb0;
-"Thai_thonangmontho",0xdb1;
-"Thai_thophuthao",0xdb2;
-"Thai_nonen",0xdb3;
-"Thai_dodek",0xdb4;
-"Thai_totao",0xdb5;
-"Thai_thothung",0xdb6;
-"Thai_thothahan",0xdb7;
-"Thai_thothong",0xdb8;
-"Thai_nonu",0xdb9;
-"Thai_bobaimai",0xdba;
-"Thai_popla",0xdbb;
-"Thai_phophung",0xdbc;
-"Thai_fofa",0xdbd;
-"Thai_phophan",0xdbe;
-"Thai_fofan",0xdbf;
-"Thai_phosamphao",0xdc0;
-"Thai_moma",0xdc1;
-"Thai_yoyak",0xdc2;
-"Thai_rorua",0xdc3;
-"Thai_ru",0xdc4;
-"Thai_loling",0xdc5;
-"Thai_lu",0xdc6;
-"Thai_wowaen",0xdc7;
-"Thai_sosala",0xdc8;
-"Thai_sorusi",0xdc9;
-"Thai_sosua",0xdca;
-"Thai_hohip",0xdcb;
-"Thai_lochula",0xdcc;
-"Thai_oang",0xdcd;
-"Thai_honokhuk",0xdce;
-"Thai_paiyannoi",0xdcf;
-"Thai_saraa",0xdd0;
-"Thai_maihanakat",0xdd1;
-"Thai_saraaa",0xdd2;
-"Thai_saraam",0xdd3;
-"Thai_sarai",0xdd4;
-"Thai_saraii",0xdd5;
-"Thai_saraue",0xdd6;
-"Thai_sarauee",0xdd7;
-"Thai_sarau",0xdd8;
-"Thai_sarauu",0xdd9;
-"Thai_phinthu",0xdda;
-"Thai_maihanakat_maitho",0xdde;
-"Thai_baht",0xddf;
-"Thai_sarae",0xde0;
-"Thai_saraae",0xde1;
-"Thai_sarao",0xde2;
-"Thai_saraaimaimuan",0xde3;
-"Thai_saraaimaimalai",0xde4;
-"Thai_lakkhangyao",0xde5;
-"Thai_maiyamok",0xde6;
-"Thai_maitaikhu",0xde7;
-"Thai_maiek",0xde8;
-"Thai_maitho",0xde9;
-"Thai_maitri",0xdea;
-"Thai_maichattawa",0xdeb;
-"Thai_thanthakhat",0xdec;
-"Thai_nikhahit",0xded;
-"Thai_leksun",0xdf0;
-"Thai_leknung",0xdf1;
-"Thai_leksong",0xdf2;
-"Thai_leksam",0xdf3;
-"Thai_leksi",0xdf4;
-"Thai_lekha",0xdf5;
-"Thai_lekhok",0xdf6;
-"Thai_lekchet",0xdf7;
-"Thai_lekpaet",0xdf8;
-"Thai_lekkao",0xdf9;
-"Hangul",0xff31;
-"Hangul_Start",0xff32;
-"Hangul_End",0xff33;
-"Hangul_Hanja",0xff34;
-"Hangul_Jamo",0xff35;
-"Hangul_Romaja",0xff36;
-"Hangul_Codeinput",0xff37;
-"Hangul_Jeonja",0xff38;
-"Hangul_Banja",0xff39;
-"Hangul_PreHanja",0xff3a;
-"Hangul_PostHanja",0xff3b;
-"Hangul_SingleCandidate",0xff3c;
-"Hangul_MultipleCandidate",0xff3d;
-"Hangul_PreviousCandidate",0xff3e;
-"Hangul_Special",0xff3f;
-"Hangul_switch",0xFF7E;
-"Hangul_Kiyeog",0xea1;
-"Hangul_SsangKiyeog",0xea2;
-"Hangul_KiyeogSios",0xea3;
-"Hangul_Nieun",0xea4;
-"Hangul_NieunJieuj",0xea5;
-"Hangul_NieunHieuh",0xea6;
-"Hangul_Dikeud",0xea7;
-"Hangul_SsangDikeud",0xea8;
-"Hangul_Rieul",0xea9;
-"Hangul_RieulKiyeog",0xeaa;
-"Hangul_RieulMieum",0xeab;
-"Hangul_RieulPieub",0xeac;
-"Hangul_RieulSios",0xead;
-"Hangul_RieulTieut",0xeae;
-"Hangul_RieulPhieuf",0xeaf;
-"Hangul_RieulHieuh",0xeb0;
-"Hangul_Mieum",0xeb1;
-"Hangul_Pieub",0xeb2;
-"Hangul_SsangPieub",0xeb3;
-"Hangul_PieubSios",0xeb4;
-"Hangul_Sios",0xeb5;
-"Hangul_SsangSios",0xeb6;
-"Hangul_Ieung",0xeb7;
-"Hangul_Jieuj",0xeb8;
-"Hangul_SsangJieuj",0xeb9;
-"Hangul_Cieuc",0xeba;
-"Hangul_Khieuq",0xebb;
-"Hangul_Tieut",0xebc;
-"Hangul_Phieuf",0xebd;
-"Hangul_Hieuh",0xebe;
-"Hangul_A",0xebf;
-"Hangul_AE",0xec0;
-"Hangul_YA",0xec1;
-"Hangul_YAE",0xec2;
-"Hangul_EO",0xec3;
-"Hangul_E",0xec4;
-"Hangul_YEO",0xec5;
-"Hangul_YE",0xec6;
-"Hangul_O",0xec7;
-"Hangul_WA",0xec8;
-"Hangul_WAE",0xec9;
-"Hangul_OE",0xeca;
-"Hangul_YO",0xecb;
-"Hangul_U",0xecc;
-"Hangul_WEO",0xecd;
-"Hangul_WE",0xece;
-"Hangul_WI",0xecf;
-"Hangul_YU",0xed0;
-"Hangul_EU",0xed1;
-"Hangul_YI",0xed2;
-"Hangul_I",0xed3;
-"Hangul_J_Kiyeog",0xed4;
-"Hangul_J_SsangKiyeog",0xed5;
-"Hangul_J_KiyeogSios",0xed6;
-"Hangul_J_Nieun",0xed7;
-"Hangul_J_NieunJieuj",0xed8;
-"Hangul_J_NieunHieuh",0xed9;
-"Hangul_J_Dikeud",0xeda;
-"Hangul_J_Rieul",0xedb;
-"Hangul_J_RieulKiyeog",0xedc;
-"Hangul_J_RieulMieum",0xedd;
-"Hangul_J_RieulPieub",0xede;
-"Hangul_J_RieulSios",0xedf;
-"Hangul_J_RieulTieut",0xee0;
-"Hangul_J_RieulPhieuf",0xee1;
-"Hangul_J_RieulHieuh",0xee2;
-"Hangul_J_Mieum",0xee3;
-"Hangul_J_Pieub",0xee4;
-"Hangul_J_PieubSios",0xee5;
-"Hangul_J_Sios",0xee6;
-"Hangul_J_SsangSios",0xee7;
-"Hangul_J_Ieung",0xee8;
-"Hangul_J_Jieuj",0xee9;
-"Hangul_J_Cieuc",0xeea;
-"Hangul_J_Khieuq",0xeeb;
-"Hangul_J_Tieut",0xeec;
-"Hangul_J_Phieuf",0xeed;
-"Hangul_J_Hieuh",0xeee;
-"Hangul_RieulYeorinHieuh",0xeef;
-"Hangul_SunkyeongeumMieum",0xef0;
-"Hangul_SunkyeongeumPieub",0xef1;
-"Hangul_PanSios",0xef2;
-"Hangul_KkogjiDalrinIeung",0xef3;
-"Hangul_SunkyeongeumPhieuf",0xef4;
-"Hangul_YeorinHieuh",0xef5;
-"Hangul_AraeA",0xef6;
-"Hangul_AraeAE",0xef7;
-"Hangul_J_PanSios",0xef8;
-"Hangul_J_KkogjiDalrinIeung",0xef9;
-"Hangul_J_YeorinHieuh",0xefa;
-"Korean_Won",0xeff;
-]
-let keysym_to_name = [
-0xFFFFFF,"VoidSymbol";
-0xFF08,"BackSpace";
-0xFF09,"Tab";
-0xFF0A,"Linefeed";
-0xFF0B,"Clear";
-0xFF0D,"Return";
-0xFF13,"Pause";
-0xFF14,"Scroll_Lock";
-0xFF15,"Sys_Req";
-0xFF1B,"Escape";
-0xFFFF,"Delete";
-0xFF20,"Multi_key";
-0xFF21,"Kanji";
-0xFF22,"Muhenkan";
-0xFF23,"Henkan_Mode";
-0xFF23,"Henkan";
-0xFF24,"Romaji";
-0xFF25,"Hiragana";
-0xFF26,"Katakana";
-0xFF27,"Hiragana_Katakana";
-0xFF28,"Zenkaku";
-0xFF29,"Hankaku";
-0xFF2A,"Zenkaku_Hankaku";
-0xFF2B,"Touroku";
-0xFF2C,"Massyo";
-0xFF2D,"Kana_Lock";
-0xFF2E,"Kana_Shift";
-0xFF2F,"Eisu_Shift";
-0xFF30,"Eisu_toggle";
-0xFF50,"Home";
-0xFF51,"Left";
-0xFF52,"Up";
-0xFF53,"Right";
-0xFF54,"Down";
-0xFF55,"Prior";
-0xFF55,"Page_Up";
-0xFF56,"Next";
-0xFF56,"Page_Down";
-0xFF57,"End";
-0xFF58,"Begin";
-0xFF60,"Select";
-0xFF61,"Print";
-0xFF62,"Execute";
-0xFF63,"Insert";
-0xFF65,"Undo";
-0xFF66,"Redo";
-0xFF67,"Menu";
-0xFF68,"Find";
-0xFF69,"Cancel";
-0xFF6A,"Help";
-0xFF6B,"Break";
-0xFF7E,"Mode_switch";
-0xFF7E,"script_switch";
-0xFF7F,"Num_Lock";
-0xFF80,"KP_Space";
-0xFF89,"KP_Tab";
-0xFF8D,"KP_Enter";
-0xFF91,"KP_F1";
-0xFF92,"KP_F2";
-0xFF93,"KP_F3";
-0xFF94,"KP_F4";
-0xFF95,"KP_Home";
-0xFF96,"KP_Left";
-0xFF97,"KP_Up";
-0xFF98,"KP_Right";
-0xFF99,"KP_Down";
-0xFF9A,"KP_Prior";
-0xFF9A,"KP_Page_Up";
-0xFF9B,"KP_Next";
-0xFF9B,"KP_Page_Down";
-0xFF9C,"KP_End";
-0xFF9D,"KP_Begin";
-0xFF9E,"KP_Insert";
-0xFF9F,"KP_Delete";
-0xFFBD,"KP_Equal";
-0xFFAA,"KP_Multiply";
-0xFFAB,"KP_Add";
-0xFFAC,"KP_Separator";
-0xFFAD,"KP_Subtract";
-0xFFAE,"KP_Decimal";
-0xFFAF,"KP_Divide";
-0xFFB0,"KP_0";
-0xFFB1,"KP_1";
-0xFFB2,"KP_2";
-0xFFB3,"KP_3";
-0xFFB4,"KP_4";
-0xFFB5,"KP_5";
-0xFFB6,"KP_6";
-0xFFB7,"KP_7";
-0xFFB8,"KP_8";
-0xFFB9,"KP_9";
-0xFFBE,"F1";
-0xFFBF,"F2";
-0xFFC0,"F3";
-0xFFC1,"F4";
-0xFFC2,"F5";
-0xFFC3,"F6";
-0xFFC4,"F7";
-0xFFC5,"F8";
-0xFFC6,"F9";
-0xFFC7,"F10";
-0xFFC8,"F11";
-0xFFC8,"L1";
-0xFFC9,"F12";
-0xFFC9,"L2";
-0xFFCA,"F13";
-0xFFCA,"L3";
-0xFFCB,"F14";
-0xFFCB,"L4";
-0xFFCC,"F15";
-0xFFCC,"L5";
-0xFFCD,"F16";
-0xFFCD,"L6";
-0xFFCE,"F17";
-0xFFCE,"L7";
-0xFFCF,"F18";
-0xFFCF,"L8";
-0xFFD0,"F19";
-0xFFD0,"L9";
-0xFFD1,"F20";
-0xFFD1,"L10";
-0xFFD2,"F21";
-0xFFD2,"R1";
-0xFFD3,"F22";
-0xFFD3,"R2";
-0xFFD4,"F23";
-0xFFD4,"R3";
-0xFFD5,"F24";
-0xFFD5,"R4";
-0xFFD6,"F25";
-0xFFD6,"R5";
-0xFFD7,"F26";
-0xFFD7,"R6";
-0xFFD8,"F27";
-0xFFD8,"R7";
-0xFFD9,"F28";
-0xFFD9,"R8";
-0xFFDA,"F29";
-0xFFDA,"R9";
-0xFFDB,"F30";
-0xFFDB,"R10";
-0xFFDC,"F31";
-0xFFDC,"R11";
-0xFFDD,"F32";
-0xFFDD,"R12";
-0xFFDE,"F33";
-0xFFDE,"R13";
-0xFFDF,"F34";
-0xFFDF,"R14";
-0xFFE0,"F35";
-0xFFE0,"R15";
-0xFFE1,"Shift_L";
-0xFFE2,"Shift_R";
-0xFFE3,"Control_L";
-0xFFE4,"Control_R";
-0xFFE5,"Caps_Lock";
-0xFFE6,"Shift_Lock";
-0xFFE7,"Meta_L";
-0xFFE8,"Meta_R";
-0xFFE9,"Alt_L";
-0xFFEA,"Alt_R";
-0xFFEB,"Super_L";
-0xFFEC,"Super_R";
-0xFFED,"Hyper_L";
-0xFFEE,"Hyper_R";
-0xFE01,"ISO_Lock";
-0xFE02,"ISO_Level2_Latch";
-0xFE03,"ISO_Level3_Shift";
-0xFE04,"ISO_Level3_Latch";
-0xFE05,"ISO_Level3_Lock";
-0xFF7E,"ISO_Group_Shift";
-0xFE06,"ISO_Group_Latch";
-0xFE07,"ISO_Group_Lock";
-0xFE08,"ISO_Next_Group";
-0xFE09,"ISO_Next_Group_Lock";
-0xFE0A,"ISO_Prev_Group";
-0xFE0B,"ISO_Prev_Group_Lock";
-0xFE0C,"ISO_First_Group";
-0xFE0D,"ISO_First_Group_Lock";
-0xFE0E,"ISO_Last_Group";
-0xFE0F,"ISO_Last_Group_Lock";
-0xFE20,"ISO_Left_Tab";
-0xFE21,"ISO_Move_Line_Up";
-0xFE22,"ISO_Move_Line_Down";
-0xFE23,"ISO_Partial_Line_Up";
-0xFE24,"ISO_Partial_Line_Down";
-0xFE25,"ISO_Partial_Space_Left";
-0xFE26,"ISO_Partial_Space_Right";
-0xFE27,"ISO_Set_Margin_Left";
-0xFE28,"ISO_Set_Margin_Right";
-0xFE29,"ISO_Release_Margin_Left";
-0xFE2A,"ISO_Release_Margin_Right";
-0xFE2B,"ISO_Release_Both_Margins";
-0xFE2C,"ISO_Fast_Cursor_Left";
-0xFE2D,"ISO_Fast_Cursor_Right";
-0xFE2E,"ISO_Fast_Cursor_Up";
-0xFE2F,"ISO_Fast_Cursor_Down";
-0xFE30,"ISO_Continuous_Underline";
-0xFE31,"ISO_Discontinuous_Underline";
-0xFE32,"ISO_Emphasize";
-0xFE33,"ISO_Center_Object";
-0xFE34,"ISO_Enter";
-0xFE50,"dead_grave";
-0xFE51,"dead_acute";
-0xFE52,"dead_circumflex";
-0xFE53,"dead_tilde";
-0xFE54,"dead_macron";
-0xFE55,"dead_breve";
-0xFE56,"dead_abovedot";
-0xFE57,"dead_diaeresis";
-0xFE58,"dead_abovering";
-0xFE59,"dead_doubleacute";
-0xFE5A,"dead_caron";
-0xFE5B,"dead_cedilla";
-0xFE5C,"dead_ogonek";
-0xFE5D,"dead_iota";
-0xFE5E,"dead_voiced_sound";
-0xFE5F,"dead_semivoiced_sound";
-0xFE60,"dead_belowdot";
-0xFED0,"First_Virtual_Screen";
-0xFED1,"Prev_Virtual_Screen";
-0xFED2,"Next_Virtual_Screen";
-0xFED4,"Last_Virtual_Screen";
-0xFED5,"Terminate_Server";
-0xFE70,"AccessX_Enable";
-0xFE71,"AccessX_Feedback_Enable";
-0xFE72,"RepeatKeys_Enable";
-0xFE73,"SlowKeys_Enable";
-0xFE74,"BounceKeys_Enable";
-0xFE75,"StickyKeys_Enable";
-0xFE76,"MouseKeys_Enable";
-0xFE77,"MouseKeys_Accel_Enable";
-0xFE78,"Overlay1_Enable";
-0xFE79,"Overlay2_Enable";
-0xFE7A,"AudibleBell_Enable";
-0xFEE0,"Pointer_Left";
-0xFEE1,"Pointer_Right";
-0xFEE2,"Pointer_Up";
-0xFEE3,"Pointer_Down";
-0xFEE4,"Pointer_UpLeft";
-0xFEE5,"Pointer_UpRight";
-0xFEE6,"Pointer_DownLeft";
-0xFEE7,"Pointer_DownRight";
-0xFEE8,"Pointer_Button_Dflt";
-0xFEE9,"Pointer_Button1";
-0xFEEA,"Pointer_Button2";
-0xFEEB,"Pointer_Button3";
-0xFEEC,"Pointer_Button4";
-0xFEED,"Pointer_Button5";
-0xFEEE,"Pointer_DblClick_Dflt";
-0xFEEF,"Pointer_DblClick1";
-0xFEF0,"Pointer_DblClick2";
-0xFEF1,"Pointer_DblClick3";
-0xFEF2,"Pointer_DblClick4";
-0xFEF3,"Pointer_DblClick5";
-0xFEF4,"Pointer_Drag_Dflt";
-0xFEF5,"Pointer_Drag1";
-0xFEF6,"Pointer_Drag2";
-0xFEF7,"Pointer_Drag3";
-0xFEF8,"Pointer_Drag4";
-0xFEFD,"Pointer_Drag5";
-0xFEF9,"Pointer_EnableKeys";
-0xFEFA,"Pointer_Accelerate";
-0xFEFB,"Pointer_DfltBtnNext";
-0xFEFC,"Pointer_DfltBtnPrev";
-0xFD01,"3270_Duplicate";
-0xFD02,"3270_FieldMark";
-0xFD03,"3270_Right2";
-0xFD04,"3270_Left2";
-0xFD05,"3270_BackTab";
-0xFD06,"3270_EraseEOF";
-0xFD07,"3270_EraseInput";
-0xFD08,"3270_Reset";
-0xFD09,"3270_Quit";
-0xFD0A,"3270_PA1";
-0xFD0B,"3270_PA2";
-0xFD0C,"3270_PA3";
-0xFD0D,"3270_Test";
-0xFD0E,"3270_Attn";
-0xFD0F,"3270_CursorBlink";
-0xFD10,"3270_AltCursor";
-0xFD11,"3270_KeyClick";
-0xFD12,"3270_Jump";
-0xFD13,"3270_Ident";
-0xFD14,"3270_Rule";
-0xFD15,"3270_Copy";
-0xFD16,"3270_Play";
-0xFD17,"3270_Setup";
-0xFD18,"3270_Record";
-0xFD19,"3270_ChangeScreen";
-0xFD1A,"3270_DeleteWord";
-0xFD1B,"3270_ExSelect";
-0xFD1C,"3270_CursorSelect";
-0xFD1D,"3270_PrintScreen";
-0xFD1E,"3270_Enter";
-0x020,"space";
-0x021,"exclam";
-0x022,"quotedbl";
-0x023,"numbersign";
-0x024,"dollar";
-0x025,"percent";
-0x026,"ampersand";
-0x027,"apostrophe";
-0x027,"quoteright";
-0x028,"parenleft";
-0x029,"parenright";
-0x02a,"asterisk";
-0x02b,"plus";
-0x02c,"comma";
-0x02d,"minus";
-0x02e,"period";
-0x02f,"slash";
-0x030,"0";
-0x031,"1";
-0x032,"2";
-0x033,"3";
-0x034,"4";
-0x035,"5";
-0x036,"6";
-0x037,"7";
-0x038,"8";
-0x039,"9";
-0x03a,"colon";
-0x03b,"semicolon";
-0x03c,"less";
-0x03d,"equal";
-0x03e,"greater";
-0x03f,"question";
-0x040,"at";
-0x041,"A";
-0x042,"B";
-0x043,"C";
-0x044,"D";
-0x045,"E";
-0x046,"F";
-0x047,"G";
-0x048,"H";
-0x049,"I";
-0x04a,"J";
-0x04b,"K";
-0x04c,"L";
-0x04d,"M";
-0x04e,"N";
-0x04f,"O";
-0x050,"P";
-0x051,"Q";
-0x052,"R";
-0x053,"S";
-0x054,"T";
-0x055,"U";
-0x056,"V";
-0x057,"W";
-0x058,"X";
-0x059,"Y";
-0x05a,"Z";
-0x05b,"bracketleft";
-0x05c,"backslash";
-0x05d,"bracketright";
-0x05e,"asciicircum";
-0x05f,"underscore";
-0x060,"grave";
-0x060,"quoteleft";
-0x061,"a";
-0x062,"b";
-0x063,"c";
-0x064,"d";
-0x065,"e";
-0x066,"f";
-0x067,"g";
-0x068,"h";
-0x069,"i";
-0x06a,"j";
-0x06b,"k";
-0x06c,"l";
-0x06d,"m";
-0x06e,"n";
-0x06f,"o";
-0x070,"p";
-0x071,"q";
-0x072,"r";
-0x073,"s";
-0x074,"t";
-0x075,"u";
-0x076,"v";
-0x077,"w";
-0x078,"x";
-0x079,"y";
-0x07a,"z";
-0x07b,"braceleft";
-0x07c,"bar";
-0x07d,"braceright";
-0x07e,"asciitilde";
-0x0a0,"nobreakspace";
-0x0a1,"exclamdown";
-0x0a2,"cent";
-0x0a3,"sterling";
-0x0a4,"currency";
-0x0a5,"yen";
-0x0a6,"brokenbar";
-0x0a7,"section";
-0x0a8,"diaeresis";
-0x0a9,"copyright";
-0x0aa,"ordfeminine";
-0x0ab,"guillemotleft";
-0x0ac,"notsign";
-0x0ad,"hyphen";
-0x0ae,"registered";
-0x0af,"macron";
-0x0b0,"degree";
-0x0b1,"plusminus";
-0x0b2,"twosuperior";
-0x0b3,"threesuperior";
-0x0b4,"acute";
-0x0b5,"mu";
-0x0b6,"paragraph";
-0x0b7,"periodcentered";
-0x0b8,"cedilla";
-0x0b9,"onesuperior";
-0x0ba,"masculine";
-0x0bb,"guillemotright";
-0x0bc,"onequarter";
-0x0bd,"onehalf";
-0x0be,"threequarters";
-0x0bf,"questiondown";
-0x0c0,"Agrave";
-0x0c1,"Aacute";
-0x0c2,"Acircumflex";
-0x0c3,"Atilde";
-0x0c4,"Adiaeresis";
-0x0c5,"Aring";
-0x0c6,"AE";
-0x0c7,"Ccedilla";
-0x0c8,"Egrave";
-0x0c9,"Eacute";
-0x0ca,"Ecircumflex";
-0x0cb,"Ediaeresis";
-0x0cc,"Igrave";
-0x0cd,"Iacute";
-0x0ce,"Icircumflex";
-0x0cf,"Idiaeresis";
-0x0d0,"ETH";
-0x0d0,"Eth";
-0x0d1,"Ntilde";
-0x0d2,"Ograve";
-0x0d3,"Oacute";
-0x0d4,"Ocircumflex";
-0x0d5,"Otilde";
-0x0d6,"Odiaeresis";
-0x0d7,"multiply";
-0x0d8,"Ooblique";
-0x0d9,"Ugrave";
-0x0da,"Uacute";
-0x0db,"Ucircumflex";
-0x0dc,"Udiaeresis";
-0x0dd,"Yacute";
-0x0de,"THORN";
-0x0de,"Thorn";
-0x0df,"ssharp";
-0x0e0,"agrave";
-0x0e1,"aacute";
-0x0e2,"acircumflex";
-0x0e3,"atilde";
-0x0e4,"adiaeresis";
-0x0e5,"aring";
-0x0e6,"ae";
-0x0e7,"ccedilla";
-0x0e8,"egrave";
-0x0e9,"eacute";
-0x0ea,"ecircumflex";
-0x0eb,"ediaeresis";
-0x0ec,"igrave";
-0x0ed,"iacute";
-0x0ee,"icircumflex";
-0x0ef,"idiaeresis";
-0x0f0,"eth";
-0x0f1,"ntilde";
-0x0f2,"ograve";
-0x0f3,"oacute";
-0x0f4,"ocircumflex";
-0x0f5,"otilde";
-0x0f6,"odiaeresis";
-0x0f7,"division";
-0x0f8,"oslash";
-0x0f9,"ugrave";
-0x0fa,"uacute";
-0x0fb,"ucircumflex";
-0x0fc,"udiaeresis";
-0x0fd,"yacute";
-0x0fe,"thorn";
-0x0ff,"ydiaeresis";
-0x1a1,"Aogonek";
-0x1a2,"breve";
-0x1a3,"Lstroke";
-0x1a5,"Lcaron";
-0x1a6,"Sacute";
-0x1a9,"Scaron";
-0x1aa,"Scedilla";
-0x1ab,"Tcaron";
-0x1ac,"Zacute";
-0x1ae,"Zcaron";
-0x1af,"Zabovedot";
-0x1b1,"aogonek";
-0x1b2,"ogonek";
-0x1b3,"lstroke";
-0x1b5,"lcaron";
-0x1b6,"sacute";
-0x1b7,"caron";
-0x1b9,"scaron";
-0x1ba,"scedilla";
-0x1bb,"tcaron";
-0x1bc,"zacute";
-0x1bd,"doubleacute";
-0x1be,"zcaron";
-0x1bf,"zabovedot";
-0x1c0,"Racute";
-0x1c3,"Abreve";
-0x1c5,"Lacute";
-0x1c6,"Cacute";
-0x1c8,"Ccaron";
-0x1ca,"Eogonek";
-0x1cc,"Ecaron";
-0x1cf,"Dcaron";
-0x1d0,"Dstroke";
-0x1d1,"Nacute";
-0x1d2,"Ncaron";
-0x1d5,"Odoubleacute";
-0x1d8,"Rcaron";
-0x1d9,"Uring";
-0x1db,"Udoubleacute";
-0x1de,"Tcedilla";
-0x1e0,"racute";
-0x1e3,"abreve";
-0x1e5,"lacute";
-0x1e6,"cacute";
-0x1e8,"ccaron";
-0x1ea,"eogonek";
-0x1ec,"ecaron";
-0x1ef,"dcaron";
-0x1f0,"dstroke";
-0x1f1,"nacute";
-0x1f2,"ncaron";
-0x1f5,"odoubleacute";
-0x1fb,"udoubleacute";
-0x1f8,"rcaron";
-0x1f9,"uring";
-0x1fe,"tcedilla";
-0x1ff,"abovedot";
-0x2a1,"Hstroke";
-0x2a6,"Hcircumflex";
-0x2a9,"Iabovedot";
-0x2ab,"Gbreve";
-0x2ac,"Jcircumflex";
-0x2b1,"hstroke";
-0x2b6,"hcircumflex";
-0x2b9,"idotless";
-0x2bb,"gbreve";
-0x2bc,"jcircumflex";
-0x2c5,"Cabovedot";
-0x2c6,"Ccircumflex";
-0x2d5,"Gabovedot";
-0x2d8,"Gcircumflex";
-0x2dd,"Ubreve";
-0x2de,"Scircumflex";
-0x2e5,"cabovedot";
-0x2e6,"ccircumflex";
-0x2f5,"gabovedot";
-0x2f8,"gcircumflex";
-0x2fd,"ubreve";
-0x2fe,"scircumflex";
-0x3a2,"kra";
-0x3a2,"kappa";
-0x3a3,"Rcedilla";
-0x3a5,"Itilde";
-0x3a6,"Lcedilla";
-0x3aa,"Emacron";
-0x3ab,"Gcedilla";
-0x3ac,"Tslash";
-0x3b3,"rcedilla";
-0x3b5,"itilde";
-0x3b6,"lcedilla";
-0x3ba,"emacron";
-0x3bb,"gcedilla";
-0x3bc,"tslash";
-0x3bd,"ENG";
-0x3bf,"eng";
-0x3c0,"Amacron";
-0x3c7,"Iogonek";
-0x3cc,"Eabovedot";
-0x3cf,"Imacron";
-0x3d1,"Ncedilla";
-0x3d2,"Omacron";
-0x3d3,"Kcedilla";
-0x3d9,"Uogonek";
-0x3dd,"Utilde";
-0x3de,"Umacron";
-0x3e0,"amacron";
-0x3e7,"iogonek";
-0x3ec,"eabovedot";
-0x3ef,"imacron";
-0x3f1,"ncedilla";
-0x3f2,"omacron";
-0x3f3,"kcedilla";
-0x3f9,"uogonek";
-0x3fd,"utilde";
-0x3fe,"umacron";
-0x47e,"overline";
-0x4a1,"kana_fullstop";
-0x4a2,"kana_openingbracket";
-0x4a3,"kana_closingbracket";
-0x4a4,"kana_comma";
-0x4a5,"kana_conjunctive";
-0x4a5,"kana_middledot";
-0x4a6,"kana_WO";
-0x4a7,"kana_a";
-0x4a8,"kana_i";
-0x4a9,"kana_u";
-0x4aa,"kana_e";
-0x4ab,"kana_o";
-0x4ac,"kana_ya";
-0x4ad,"kana_yu";
-0x4ae,"kana_yo";
-0x4af,"kana_tsu";
-0x4af,"kana_tu";
-0x4b0,"prolongedsound";
-0x4b1,"kana_A";
-0x4b2,"kana_I";
-0x4b3,"kana_U";
-0x4b4,"kana_E";
-0x4b5,"kana_O";
-0x4b6,"kana_KA";
-0x4b7,"kana_KI";
-0x4b8,"kana_KU";
-0x4b9,"kana_KE";
-0x4ba,"kana_KO";
-0x4bb,"kana_SA";
-0x4bc,"kana_SHI";
-0x4bd,"kana_SU";
-0x4be,"kana_SE";
-0x4bf,"kana_SO";
-0x4c0,"kana_TA";
-0x4c1,"kana_CHI";
-0x4c1,"kana_TI";
-0x4c2,"kana_TSU";
-0x4c2,"kana_TU";
-0x4c3,"kana_TE";
-0x4c4,"kana_TO";
-0x4c5,"kana_NA";
-0x4c6,"kana_NI";
-0x4c7,"kana_NU";
-0x4c8,"kana_NE";
-0x4c9,"kana_NO";
-0x4ca,"kana_HA";
-0x4cb,"kana_HI";
-0x4cc,"kana_FU";
-0x4cc,"kana_HU";
-0x4cd,"kana_HE";
-0x4ce,"kana_HO";
-0x4cf,"kana_MA";
-0x4d0,"kana_MI";
-0x4d1,"kana_MU";
-0x4d2,"kana_ME";
-0x4d3,"kana_MO";
-0x4d4,"kana_YA";
-0x4d5,"kana_YU";
-0x4d6,"kana_YO";
-0x4d7,"kana_RA";
-0x4d8,"kana_RI";
-0x4d9,"kana_RU";
-0x4da,"kana_RE";
-0x4db,"kana_RO";
-0x4dc,"kana_WA";
-0x4dd,"kana_N";
-0x4de,"voicedsound";
-0x4df,"semivoicedsound";
-0xFF7E,"kana_switch";
-0x5ac,"Arabic_comma";
-0x5bb,"Arabic_semicolon";
-0x5bf,"Arabic_question_mark";
-0x5c1,"Arabic_hamza";
-0x5c2,"Arabic_maddaonalef";
-0x5c3,"Arabic_hamzaonalef";
-0x5c4,"Arabic_hamzaonwaw";
-0x5c5,"Arabic_hamzaunderalef";
-0x5c6,"Arabic_hamzaonyeh";
-0x5c7,"Arabic_alef";
-0x5c8,"Arabic_beh";
-0x5c9,"Arabic_tehmarbuta";
-0x5ca,"Arabic_teh";
-0x5cb,"Arabic_theh";
-0x5cc,"Arabic_jeem";
-0x5cd,"Arabic_hah";
-0x5ce,"Arabic_khah";
-0x5cf,"Arabic_dal";
-0x5d0,"Arabic_thal";
-0x5d1,"Arabic_ra";
-0x5d2,"Arabic_zain";
-0x5d3,"Arabic_seen";
-0x5d4,"Arabic_sheen";
-0x5d5,"Arabic_sad";
-0x5d6,"Arabic_dad";
-0x5d7,"Arabic_tah";
-0x5d8,"Arabic_zah";
-0x5d9,"Arabic_ain";
-0x5da,"Arabic_ghain";
-0x5e0,"Arabic_tatweel";
-0x5e1,"Arabic_feh";
-0x5e2,"Arabic_qaf";
-0x5e3,"Arabic_kaf";
-0x5e4,"Arabic_lam";
-0x5e5,"Arabic_meem";
-0x5e6,"Arabic_noon";
-0x5e7,"Arabic_ha";
-0x5e7,"Arabic_heh";
-0x5e8,"Arabic_waw";
-0x5e9,"Arabic_alefmaksura";
-0x5ea,"Arabic_yeh";
-0x5eb,"Arabic_fathatan";
-0x5ec,"Arabic_dammatan";
-0x5ed,"Arabic_kasratan";
-0x5ee,"Arabic_fatha";
-0x5ef,"Arabic_damma";
-0x5f0,"Arabic_kasra";
-0x5f1,"Arabic_shadda";
-0x5f2,"Arabic_sukun";
-0xFF7E,"Arabic_switch";
-0x6a1,"Serbian_dje";
-0x6a2,"Macedonia_gje";
-0x6a3,"Cyrillic_io";
-0x6a4,"Ukrainian_ie";
-0x6a4,"Ukranian_je";
-0x6a5,"Macedonia_dse";
-0x6a6,"Ukrainian_i";
-0x6a6,"Ukranian_i";
-0x6a7,"Ukrainian_yi";
-0x6a7,"Ukranian_yi";
-0x6a8,"Cyrillic_je";
-0x6a8,"Serbian_je";
-0x6a9,"Cyrillic_lje";
-0x6a9,"Serbian_lje";
-0x6aa,"Cyrillic_nje";
-0x6aa,"Serbian_nje";
-0x6ab,"Serbian_tshe";
-0x6ac,"Macedonia_kje";
-0x6ae,"Byelorussian_shortu";
-0x6af,"Cyrillic_dzhe";
-0x6af,"Serbian_dze";
-0x6b0,"numerosign";
-0x6b1,"Serbian_DJE";
-0x6b2,"Macedonia_GJE";
-0x6b3,"Cyrillic_IO";
-0x6b4,"Ukrainian_IE";
-0x6b4,"Ukranian_JE";
-0x6b5,"Macedonia_DSE";
-0x6b6,"Ukrainian_I";
-0x6b6,"Ukranian_I";
-0x6b7,"Ukrainian_YI";
-0x6b7,"Ukranian_YI";
-0x6b8,"Cyrillic_JE";
-0x6b8,"Serbian_JE";
-0x6b9,"Cyrillic_LJE";
-0x6b9,"Serbian_LJE";
-0x6ba,"Cyrillic_NJE";
-0x6ba,"Serbian_NJE";
-0x6bb,"Serbian_TSHE";
-0x6bc,"Macedonia_KJE";
-0x6be,"Byelorussian_SHORTU";
-0x6bf,"Cyrillic_DZHE";
-0x6bf,"Serbian_DZE";
-0x6c0,"Cyrillic_yu";
-0x6c1,"Cyrillic_a";
-0x6c2,"Cyrillic_be";
-0x6c3,"Cyrillic_tse";
-0x6c4,"Cyrillic_de";
-0x6c5,"Cyrillic_ie";
-0x6c6,"Cyrillic_ef";
-0x6c7,"Cyrillic_ghe";
-0x6c8,"Cyrillic_ha";
-0x6c9,"Cyrillic_i";
-0x6ca,"Cyrillic_shorti";
-0x6cb,"Cyrillic_ka";
-0x6cc,"Cyrillic_el";
-0x6cd,"Cyrillic_em";
-0x6ce,"Cyrillic_en";
-0x6cf,"Cyrillic_o";
-0x6d0,"Cyrillic_pe";
-0x6d1,"Cyrillic_ya";
-0x6d2,"Cyrillic_er";
-0x6d3,"Cyrillic_es";
-0x6d4,"Cyrillic_te";
-0x6d5,"Cyrillic_u";
-0x6d6,"Cyrillic_zhe";
-0x6d7,"Cyrillic_ve";
-0x6d8,"Cyrillic_softsign";
-0x6d9,"Cyrillic_yeru";
-0x6da,"Cyrillic_ze";
-0x6db,"Cyrillic_sha";
-0x6dc,"Cyrillic_e";
-0x6dd,"Cyrillic_shcha";
-0x6de,"Cyrillic_che";
-0x6df,"Cyrillic_hardsign";
-0x6e0,"Cyrillic_YU";
-0x6e1,"Cyrillic_A";
-0x6e2,"Cyrillic_BE";
-0x6e3,"Cyrillic_TSE";
-0x6e4,"Cyrillic_DE";
-0x6e5,"Cyrillic_IE";
-0x6e6,"Cyrillic_EF";
-0x6e7,"Cyrillic_GHE";
-0x6e8,"Cyrillic_HA";
-0x6e9,"Cyrillic_I";
-0x6ea,"Cyrillic_SHORTI";
-0x6eb,"Cyrillic_KA";
-0x6ec,"Cyrillic_EL";
-0x6ed,"Cyrillic_EM";
-0x6ee,"Cyrillic_EN";
-0x6ef,"Cyrillic_O";
-0x6f0,"Cyrillic_PE";
-0x6f1,"Cyrillic_YA";
-0x6f2,"Cyrillic_ER";
-0x6f3,"Cyrillic_ES";
-0x6f4,"Cyrillic_TE";
-0x6f5,"Cyrillic_U";
-0x6f6,"Cyrillic_ZHE";
-0x6f7,"Cyrillic_VE";
-0x6f8,"Cyrillic_SOFTSIGN";
-0x6f9,"Cyrillic_YERU";
-0x6fa,"Cyrillic_ZE";
-0x6fb,"Cyrillic_SHA";
-0x6fc,"Cyrillic_E";
-0x6fd,"Cyrillic_SHCHA";
-0x6fe,"Cyrillic_CHE";
-0x6ff,"Cyrillic_HARDSIGN";
-0x7a1,"Greek_ALPHAaccent";
-0x7a2,"Greek_EPSILONaccent";
-0x7a3,"Greek_ETAaccent";
-0x7a4,"Greek_IOTAaccent";
-0x7a5,"Greek_IOTAdiaeresis";
-0x7a7,"Greek_OMICRONaccent";
-0x7a8,"Greek_UPSILONaccent";
-0x7a9,"Greek_UPSILONdieresis";
-0x7ab,"Greek_OMEGAaccent";
-0x7ae,"Greek_accentdieresis";
-0x7af,"Greek_horizbar";
-0x7b1,"Greek_alphaaccent";
-0x7b2,"Greek_epsilonaccent";
-0x7b3,"Greek_etaaccent";
-0x7b4,"Greek_iotaaccent";
-0x7b5,"Greek_iotadieresis";
-0x7b6,"Greek_iotaaccentdieresis";
-0x7b7,"Greek_omicronaccent";
-0x7b8,"Greek_upsilonaccent";
-0x7b9,"Greek_upsilondieresis";
-0x7ba,"Greek_upsilonaccentdieresis";
-0x7bb,"Greek_omegaaccent";
-0x7c1,"Greek_ALPHA";
-0x7c2,"Greek_BETA";
-0x7c3,"Greek_GAMMA";
-0x7c4,"Greek_DELTA";
-0x7c5,"Greek_EPSILON";
-0x7c6,"Greek_ZETA";
-0x7c7,"Greek_ETA";
-0x7c8,"Greek_THETA";
-0x7c9,"Greek_IOTA";
-0x7ca,"Greek_KAPPA";
-0x7cb,"Greek_LAMDA";
-0x7cb,"Greek_LAMBDA";
-0x7cc,"Greek_MU";
-0x7cd,"Greek_NU";
-0x7ce,"Greek_XI";
-0x7cf,"Greek_OMICRON";
-0x7d0,"Greek_PI";
-0x7d1,"Greek_RHO";
-0x7d2,"Greek_SIGMA";
-0x7d4,"Greek_TAU";
-0x7d5,"Greek_UPSILON";
-0x7d6,"Greek_PHI";
-0x7d7,"Greek_CHI";
-0x7d8,"Greek_PSI";
-0x7d9,"Greek_OMEGA";
-0x7e1,"Greek_alpha";
-0x7e2,"Greek_beta";
-0x7e3,"Greek_gamma";
-0x7e4,"Greek_delta";
-0x7e5,"Greek_epsilon";
-0x7e6,"Greek_zeta";
-0x7e7,"Greek_eta";
-0x7e8,"Greek_theta";
-0x7e9,"Greek_iota";
-0x7ea,"Greek_kappa";
-0x7eb,"Greek_lamda";
-0x7eb,"Greek_lambda";
-0x7ec,"Greek_mu";
-0x7ed,"Greek_nu";
-0x7ee,"Greek_xi";
-0x7ef,"Greek_omicron";
-0x7f0,"Greek_pi";
-0x7f1,"Greek_rho";
-0x7f2,"Greek_sigma";
-0x7f3,"Greek_finalsmallsigma";
-0x7f4,"Greek_tau";
-0x7f5,"Greek_upsilon";
-0x7f6,"Greek_phi";
-0x7f7,"Greek_chi";
-0x7f8,"Greek_psi";
-0x7f9,"Greek_omega";
-0xFF7E,"Greek_switch";
-0x8a1,"leftradical";
-0x8a2,"topleftradical";
-0x8a3,"horizconnector";
-0x8a4,"topintegral";
-0x8a5,"botintegral";
-0x8a6,"vertconnector";
-0x8a7,"topleftsqbracket";
-0x8a8,"botleftsqbracket";
-0x8a9,"toprightsqbracket";
-0x8aa,"botrightsqbracket";
-0x8ab,"topleftparens";
-0x8ac,"botleftparens";
-0x8ad,"toprightparens";
-0x8ae,"botrightparens";
-0x8af,"leftmiddlecurlybrace";
-0x8b0,"rightmiddlecurlybrace";
-0x8b1,"topleftsummation";
-0x8b2,"botleftsummation";
-0x8b3,"topvertsummationconnector";
-0x8b4,"botvertsummationconnector";
-0x8b5,"toprightsummation";
-0x8b6,"botrightsummation";
-0x8b7,"rightmiddlesummation";
-0x8bc,"lessthanequal";
-0x8bd,"notequal";
-0x8be,"greaterthanequal";
-0x8bf,"integral";
-0x8c0,"therefore";
-0x8c1,"variation";
-0x8c2,"infinity";
-0x8c5,"nabla";
-0x8c8,"approximate";
-0x8c9,"similarequal";
-0x8cd,"ifonlyif";
-0x8ce,"implies";
-0x8cf,"identical";
-0x8d6,"radical";
-0x8da,"includedin";
-0x8db,"includes";
-0x8dc,"intersection";
-0x8dd,"union";
-0x8de,"logicaland";
-0x8df,"logicalor";
-0x8ef,"partialderivative";
-0x8f6,"function";
-0x8fb,"leftarrow";
-0x8fc,"uparrow";
-0x8fd,"rightarrow";
-0x8fe,"downarrow";
-0x9df,"blank";
-0x9e0,"soliddiamond";
-0x9e1,"checkerboard";
-0x9e2,"ht";
-0x9e3,"ff";
-0x9e4,"cr";
-0x9e5,"lf";
-0x9e8,"nl";
-0x9e9,"vt";
-0x9ea,"lowrightcorner";
-0x9eb,"uprightcorner";
-0x9ec,"upleftcorner";
-0x9ed,"lowleftcorner";
-0x9ee,"crossinglines";
-0x9ef,"horizlinescan1";
-0x9f0,"horizlinescan3";
-0x9f1,"horizlinescan5";
-0x9f2,"horizlinescan7";
-0x9f3,"horizlinescan9";
-0x9f4,"leftt";
-0x9f5,"rightt";
-0x9f6,"bott";
-0x9f7,"topt";
-0x9f8,"vertbar";
-0xaa1,"emspace";
-0xaa2,"enspace";
-0xaa3,"em3space";
-0xaa4,"em4space";
-0xaa5,"digitspace";
-0xaa6,"punctspace";
-0xaa7,"thinspace";
-0xaa8,"hairspace";
-0xaa9,"emdash";
-0xaaa,"endash";
-0xaac,"signifblank";
-0xaae,"ellipsis";
-0xaaf,"doubbaselinedot";
-0xab0,"onethird";
-0xab1,"twothirds";
-0xab2,"onefifth";
-0xab3,"twofifths";
-0xab4,"threefifths";
-0xab5,"fourfifths";
-0xab6,"onesixth";
-0xab7,"fivesixths";
-0xab8,"careof";
-0xabb,"figdash";
-0xabc,"leftanglebracket";
-0xabd,"decimalpoint";
-0xabe,"rightanglebracket";
-0xabf,"marker";
-0xac3,"oneeighth";
-0xac4,"threeeighths";
-0xac5,"fiveeighths";
-0xac6,"seveneighths";
-0xac9,"trademark";
-0xaca,"signaturemark";
-0xacb,"trademarkincircle";
-0xacc,"leftopentriangle";
-0xacd,"rightopentriangle";
-0xace,"emopencircle";
-0xacf,"emopenrectangle";
-0xad0,"leftsinglequotemark";
-0xad1,"rightsinglequotemark";
-0xad2,"leftdoublequotemark";
-0xad3,"rightdoublequotemark";
-0xad4,"prescription";
-0xad6,"minutes";
-0xad7,"seconds";
-0xad9,"latincross";
-0xada,"hexagram";
-0xadb,"filledrectbullet";
-0xadc,"filledlefttribullet";
-0xadd,"filledrighttribullet";
-0xade,"emfilledcircle";
-0xadf,"emfilledrect";
-0xae0,"enopencircbullet";
-0xae1,"enopensquarebullet";
-0xae2,"openrectbullet";
-0xae3,"opentribulletup";
-0xae4,"opentribulletdown";
-0xae5,"openstar";
-0xae6,"enfilledcircbullet";
-0xae7,"enfilledsqbullet";
-0xae8,"filledtribulletup";
-0xae9,"filledtribulletdown";
-0xaea,"leftpointer";
-0xaeb,"rightpointer";
-0xaec,"club";
-0xaed,"diamond";
-0xaee,"heart";
-0xaf0,"maltesecross";
-0xaf1,"dagger";
-0xaf2,"doubledagger";
-0xaf3,"checkmark";
-0xaf4,"ballotcross";
-0xaf5,"musicalsharp";
-0xaf6,"musicalflat";
-0xaf7,"malesymbol";
-0xaf8,"femalesymbol";
-0xaf9,"telephone";
-0xafa,"telephonerecorder";
-0xafb,"phonographcopyright";
-0xafc,"caret";
-0xafd,"singlelowquotemark";
-0xafe,"doublelowquotemark";
-0xaff,"cursor";
-0xba3,"leftcaret";
-0xba6,"rightcaret";
-0xba8,"downcaret";
-0xba9,"upcaret";
-0xbc0,"overbar";
-0xbc2,"downtack";
-0xbc3,"upshoe";
-0xbc4,"downstile";
-0xbc6,"underbar";
-0xbca,"jot";
-0xbcc,"quad";
-0xbce,"uptack";
-0xbcf,"circle";
-0xbd3,"upstile";
-0xbd6,"downshoe";
-0xbd8,"rightshoe";
-0xbda,"leftshoe";
-0xbdc,"lefttack";
-0xbfc,"righttack";
-0xcdf,"hebrew_doublelowline";
-0xce0,"hebrew_aleph";
-0xce1,"hebrew_bet";
-0xce1,"hebrew_beth";
-0xce2,"hebrew_gimel";
-0xce2,"hebrew_gimmel";
-0xce3,"hebrew_dalet";
-0xce3,"hebrew_daleth";
-0xce4,"hebrew_he";
-0xce5,"hebrew_waw";
-0xce6,"hebrew_zain";
-0xce6,"hebrew_zayin";
-0xce7,"hebrew_chet";
-0xce7,"hebrew_het";
-0xce8,"hebrew_tet";
-0xce8,"hebrew_teth";
-0xce9,"hebrew_yod";
-0xcea,"hebrew_finalkaph";
-0xceb,"hebrew_kaph";
-0xcec,"hebrew_lamed";
-0xced,"hebrew_finalmem";
-0xcee,"hebrew_mem";
-0xcef,"hebrew_finalnun";
-0xcf0,"hebrew_nun";
-0xcf1,"hebrew_samech";
-0xcf1,"hebrew_samekh";
-0xcf2,"hebrew_ayin";
-0xcf3,"hebrew_finalpe";
-0xcf4,"hebrew_pe";
-0xcf5,"hebrew_finalzade";
-0xcf5,"hebrew_finalzadi";
-0xcf6,"hebrew_zade";
-0xcf6,"hebrew_zadi";
-0xcf7,"hebrew_qoph";
-0xcf7,"hebrew_kuf";
-0xcf8,"hebrew_resh";
-0xcf9,"hebrew_shin";
-0xcfa,"hebrew_taw";
-0xcfa,"hebrew_taf";
-0xFF7E,"Hebrew_switch";
-0xda1,"Thai_kokai";
-0xda2,"Thai_khokhai";
-0xda3,"Thai_khokhuat";
-0xda4,"Thai_khokhwai";
-0xda5,"Thai_khokhon";
-0xda6,"Thai_khorakhang";
-0xda7,"Thai_ngongu";
-0xda8,"Thai_chochan";
-0xda9,"Thai_choching";
-0xdaa,"Thai_chochang";
-0xdab,"Thai_soso";
-0xdac,"Thai_chochoe";
-0xdad,"Thai_yoying";
-0xdae,"Thai_dochada";
-0xdaf,"Thai_topatak";
-0xdb0,"Thai_thothan";
-0xdb1,"Thai_thonangmontho";
-0xdb2,"Thai_thophuthao";
-0xdb3,"Thai_nonen";
-0xdb4,"Thai_dodek";
-0xdb5,"Thai_totao";
-0xdb6,"Thai_thothung";
-0xdb7,"Thai_thothahan";
-0xdb8,"Thai_thothong";
-0xdb9,"Thai_nonu";
-0xdba,"Thai_bobaimai";
-0xdbb,"Thai_popla";
-0xdbc,"Thai_phophung";
-0xdbd,"Thai_fofa";
-0xdbe,"Thai_phophan";
-0xdbf,"Thai_fofan";
-0xdc0,"Thai_phosamphao";
-0xdc1,"Thai_moma";
-0xdc2,"Thai_yoyak";
-0xdc3,"Thai_rorua";
-0xdc4,"Thai_ru";
-0xdc5,"Thai_loling";
-0xdc6,"Thai_lu";
-0xdc7,"Thai_wowaen";
-0xdc8,"Thai_sosala";
-0xdc9,"Thai_sorusi";
-0xdca,"Thai_sosua";
-0xdcb,"Thai_hohip";
-0xdcc,"Thai_lochula";
-0xdcd,"Thai_oang";
-0xdce,"Thai_honokhuk";
-0xdcf,"Thai_paiyannoi";
-0xdd0,"Thai_saraa";
-0xdd1,"Thai_maihanakat";
-0xdd2,"Thai_saraaa";
-0xdd3,"Thai_saraam";
-0xdd4,"Thai_sarai";
-0xdd5,"Thai_saraii";
-0xdd6,"Thai_saraue";
-0xdd7,"Thai_sarauee";
-0xdd8,"Thai_sarau";
-0xdd9,"Thai_sarauu";
-0xdda,"Thai_phinthu";
-0xdde,"Thai_maihanakat_maitho";
-0xddf,"Thai_baht";
-0xde0,"Thai_sarae";
-0xde1,"Thai_saraae";
-0xde2,"Thai_sarao";
-0xde3,"Thai_saraaimaimuan";
-0xde4,"Thai_saraaimaimalai";
-0xde5,"Thai_lakkhangyao";
-0xde6,"Thai_maiyamok";
-0xde7,"Thai_maitaikhu";
-0xde8,"Thai_maiek";
-0xde9,"Thai_maitho";
-0xdea,"Thai_maitri";
-0xdeb,"Thai_maichattawa";
-0xdec,"Thai_thanthakhat";
-0xded,"Thai_nikhahit";
-0xdf0,"Thai_leksun";
-0xdf1,"Thai_leknung";
-0xdf2,"Thai_leksong";
-0xdf3,"Thai_leksam";
-0xdf4,"Thai_leksi";
-0xdf5,"Thai_lekha";
-0xdf6,"Thai_lekhok";
-0xdf7,"Thai_lekchet";
-0xdf8,"Thai_lekpaet";
-0xdf9,"Thai_lekkao";
-0xff31,"Hangul";
-0xff32,"Hangul_Start";
-0xff33,"Hangul_End";
-0xff34,"Hangul_Hanja";
-0xff35,"Hangul_Jamo";
-0xff36,"Hangul_Romaja";
-0xff37,"Hangul_Codeinput";
-0xff38,"Hangul_Jeonja";
-0xff39,"Hangul_Banja";
-0xff3a,"Hangul_PreHanja";
-0xff3b,"Hangul_PostHanja";
-0xff3c,"Hangul_SingleCandidate";
-0xff3d,"Hangul_MultipleCandidate";
-0xff3e,"Hangul_PreviousCandidate";
-0xff3f,"Hangul_Special";
-0xFF7E,"Hangul_switch";
-0xea1,"Hangul_Kiyeog";
-0xea2,"Hangul_SsangKiyeog";
-0xea3,"Hangul_KiyeogSios";
-0xea4,"Hangul_Nieun";
-0xea5,"Hangul_NieunJieuj";
-0xea6,"Hangul_NieunHieuh";
-0xea7,"Hangul_Dikeud";
-0xea8,"Hangul_SsangDikeud";
-0xea9,"Hangul_Rieul";
-0xeaa,"Hangul_RieulKiyeog";
-0xeab,"Hangul_RieulMieum";
-0xeac,"Hangul_RieulPieub";
-0xead,"Hangul_RieulSios";
-0xeae,"Hangul_RieulTieut";
-0xeaf,"Hangul_RieulPhieuf";
-0xeb0,"Hangul_RieulHieuh";
-0xeb1,"Hangul_Mieum";
-0xeb2,"Hangul_Pieub";
-0xeb3,"Hangul_SsangPieub";
-0xeb4,"Hangul_PieubSios";
-0xeb5,"Hangul_Sios";
-0xeb6,"Hangul_SsangSios";
-0xeb7,"Hangul_Ieung";
-0xeb8,"Hangul_Jieuj";
-0xeb9,"Hangul_SsangJieuj";
-0xeba,"Hangul_Cieuc";
-0xebb,"Hangul_Khieuq";
-0xebc,"Hangul_Tieut";
-0xebd,"Hangul_Phieuf";
-0xebe,"Hangul_Hieuh";
-0xebf,"Hangul_A";
-0xec0,"Hangul_AE";
-0xec1,"Hangul_YA";
-0xec2,"Hangul_YAE";
-0xec3,"Hangul_EO";
-0xec4,"Hangul_E";
-0xec5,"Hangul_YEO";
-0xec6,"Hangul_YE";
-0xec7,"Hangul_O";
-0xec8,"Hangul_WA";
-0xec9,"Hangul_WAE";
-0xeca,"Hangul_OE";
-0xecb,"Hangul_YO";
-0xecc,"Hangul_U";
-0xecd,"Hangul_WEO";
-0xece,"Hangul_WE";
-0xecf,"Hangul_WI";
-0xed0,"Hangul_YU";
-0xed1,"Hangul_EU";
-0xed2,"Hangul_YI";
-0xed3,"Hangul_I";
-0xed4,"Hangul_J_Kiyeog";
-0xed5,"Hangul_J_SsangKiyeog";
-0xed6,"Hangul_J_KiyeogSios";
-0xed7,"Hangul_J_Nieun";
-0xed8,"Hangul_J_NieunJieuj";
-0xed9,"Hangul_J_NieunHieuh";
-0xeda,"Hangul_J_Dikeud";
-0xedb,"Hangul_J_Rieul";
-0xedc,"Hangul_J_RieulKiyeog";
-0xedd,"Hangul_J_RieulMieum";
-0xede,"Hangul_J_RieulPieub";
-0xedf,"Hangul_J_RieulSios";
-0xee0,"Hangul_J_RieulTieut";
-0xee1,"Hangul_J_RieulPhieuf";
-0xee2,"Hangul_J_RieulHieuh";
-0xee3,"Hangul_J_Mieum";
-0xee4,"Hangul_J_Pieub";
-0xee5,"Hangul_J_PieubSios";
-0xee6,"Hangul_J_Sios";
-0xee7,"Hangul_J_SsangSios";
-0xee8,"Hangul_J_Ieung";
-0xee9,"Hangul_J_Jieuj";
-0xeea,"Hangul_J_Cieuc";
-0xeeb,"Hangul_J_Khieuq";
-0xeec,"Hangul_J_Tieut";
-0xeed,"Hangul_J_Phieuf";
-0xeee,"Hangul_J_Hieuh";
-0xeef,"Hangul_RieulYeorinHieuh";
-0xef0,"Hangul_SunkyeongeumMieum";
-0xef1,"Hangul_SunkyeongeumPieub";
-0xef2,"Hangul_PanSios";
-0xef3,"Hangul_KkogjiDalrinIeung";
-0xef4,"Hangul_SunkyeongeumPhieuf";
-0xef5,"Hangul_YeorinHieuh";
-0xef6,"Hangul_AraeA";
-0xef7,"Hangul_AraeAE";
-0xef8,"Hangul_J_PanSios";
-0xef9,"Hangul_J_KkogjiDalrinIeung";
-0xefa,"Hangul_J_YeorinHieuh";
-0xeff,"Korean_Won";
-]
diff --git a/ide/utils/configwin_types.ml b/ide/utils/configwin_types.mli
index ace751c64..9e339d135 100644
--- a/ide/utils/configwin_types.ml
+++ b/ide/utils/configwin_types.mli
@@ -25,113 +25,6 @@
 
 (** This module contains the types used in Configwin. *)
 
-open Config_file
-
-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
-      | _ ->
-	  Minilib.log 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 ->
-      Minilib.log 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 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
-    Raw.String s -> string_to_key s
-  | _ ->
-      Minilib.log "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 ;
-  }
-
-(** 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 = {
@@ -188,49 +81,6 @@ type custom_param = {
     custom_framed : string option ; (** optional label for an optional frame *)
   } ;;
 
-type color_param = {
-    color_label : string; (** the label of the parameter *)
-    mutable color_value : string; (** the current value of the parameter *)
-    color_editable : bool ; (** indicates if the value can be changed *)
-    color_f_apply : (string -> unit) ; (** the function to call to apply the new value of the parameter *)
-    color_help : string option ; (** optional help string *)
-    color_expand : bool ; (** expand the entry widget or not *)
-  } ;;
-
-type date_param = {
-    date_label : string ; (** the label of the parameter *)
-    mutable date_value : int * int * int ; (** day, month, year *)
-    date_editable : bool ; (** indicates if the value can be changed *)
-    date_f_string : (int * int * int) -> string ;
-      (** the function used to display the current value (day, month, year) *)
-    date_f_apply : ((int * int * int) -> unit) ;
-      (** the function to call to apply the new value (day, month, year) of the parameter *)
-    date_help : string option ; (** optional help string *)
-    date_expand : bool ; (** expand the entry widget or not *)
-  } ;;
-
-type font_param = {
-    font_label : string ; (** the label of the parameter *)
-    mutable font_value : string ; (** the font name *)
-    font_editable : bool ; (** indicates if the value can be changed *)
-    font_f_apply : (string -> unit) ;
-      (** the function to call to apply the new value of the parameter *)
-    font_help : string option ; (** optional help string *)
-    font_expand : bool ; (** expand the entry widget or not *)
-  } ;;
-
-
-type hotkey_param = {
-    hk_label : string ; (** the label of the parameter *)
-    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 *)
     mutable md_value : Gdk.Tags.modifier list ;
@@ -248,17 +98,11 @@ type modifiers_param = {
 type parameter_kind =
     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 string_param
   | Combo_param of combo_param
   | Custom_param of custom_param
-  | Color_param of color_param
-  | Date_param of date_param
-  | Font_param of font_param
-  | Hotkey_param of hotkey_param
   | Modifiers_param of modifiers_param
-  | Html_param of string string_param
 ;;
 
 (** This type represents the structure of the configuration window. *)
@@ -275,28 +119,3 @@ type return_button =
   | Return_cancel (** The user closed the window with the cancel
 		     button or the window manager but never clicked
 		     on the apply button.*)
-
-(** {2 Bindings in the html editor} *)
-
-type html_binding = {
-    mutable html_key :  (Gdk.Tags.modifier list * int) ;
-    mutable html_begin : string ;
-    mutable html_end : string ;
-  }
-
-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 }
-      ) ;
-  }
-
-class htmlbinding_cp =
-  [html_binding] Config_file.option_cp htmlbinding_cp_wrapper
diff --git a/ide/utils/editable_cells.ml b/ide/utils/editable_cells.ml
deleted file mode 100644
index 33968b8dd..000000000
--- a/ide/utils/editable_cells.ml
+++ /dev/null
@@ -1,113 +0,0 @@
-open Gobject
-
-let create l =
-  let hbox = GPack.hbox () in
-  let scw = GBin.scrolled_window
-	      ~hpolicy:`AUTOMATIC
-	      ~vpolicy:`AUTOMATIC
-	      ~packing:(hbox#pack ~expand:true) () in
-
-  let columns = new GTree.column_list in
-  let command_col =  columns#add Data.string in
-  let coq_col = columns#add Data.string in
-  let store = GTree.list_store columns
-  in
-
-(* populate the store *)
-  let _ = List.iter (fun (x,y) ->
-		       let row = store#append () in
-		       store#set ~row ~column:command_col x;
-		       store#set ~row ~column:coq_col y)
-	    l
-  in
-  let view = GTree.view ~model:store ~packing:scw#add_with_viewport () in
-
-  (* Alternate colors for the rows *)
-  view#set_rules_hint true;
-
-  let renderer_comm = GTree.cell_renderer_text [`EDITABLE true]  in
-  ignore (renderer_comm#connect#edited
-    ~callback:(fun (path:Gtk.tree_path) (s:string) ->
-		 store#set
-		 ~row:(store#get_iter path)
-		 ~column:command_col s));
-  let first =
-    GTree.view_column ~title:"Coq Command to try"
-      ~renderer:(renderer_comm,["text",command_col])
-      ()
-  in ignore (view#append_column first);
-
-  let renderer_coq = GTree.cell_renderer_text [`EDITABLE true] in
-  ignore(renderer_coq#connect#edited
-	   ~callback:(fun (path:Gtk.tree_path) (s:string) ->
-			store#set
-			~row:(store#get_iter path)
-			~column:coq_col s));
-  let second =
-    GTree.view_column ~title:"Coq Command to insert"
-      ~renderer:(renderer_coq,["text",coq_col])
-      ()
-  in ignore (view#append_column second);
-
-  let vbox = GPack.button_box `VERTICAL ~packing:hbox#pack ~layout:`SPREAD ()
-  in
-  let up = GButton.button  ~stock:`GO_UP ~label:"Up" ~packing:(vbox#pack ~expand:true ~fill:false) () in
-  let down = GButton.button
-	       ~stock:`GO_DOWN
-	       ~label:"Down"
-	       ~packing:(vbox#pack ~expand:true ~fill:false) ()
-  in
-  let add = GButton.button ~stock:`ADD
-	      ~label:"Add"
-	      ~packing:(vbox#pack ~expand:true ~fill:false)
-	      ()
-  in
-  let remove = GButton.button ~stock:`REMOVE
-		 ~label:"Remove"
-		 ~packing:(vbox#pack ~expand:true ~fill:false) ()
-  in
-
-  ignore (add#connect#clicked
-	    ~callback:(fun b ->
-			 let n = store#append () in
-			 view#selection#select_iter n));
-  ignore (remove#connect#clicked
-	    ~callback:(fun b -> match view#selection#get_selected_rows with
-			 | [] -> ()
-			 | path::_ ->
-			     let iter = store#get_iter path in
-		       	     ignore (store#remove iter);
-		      ));
-  ignore (up#connect#clicked
-	    ~callback:(fun b ->
-			 match view#selection#get_selected_rows with
-			   | [] -> ()
-			   | path::_ ->
-			       let iter = store#get_iter path in
-			       ignore (GtkTree.TreePath.prev path);
-			       let upiter = store#get_iter path in
-			       ignore (store#swap iter upiter);
-		      ));
-  ignore (down#connect#clicked
-	    ~callback:(fun b ->
-			 match view#selection#get_selected_rows with
-			   | [] -> ()
-			   | path::_ ->
-			       let iter = store#get_iter path in
-			       GtkTree.TreePath.next path;
-			       try let upiter = store#get_iter path in
-			       ignore (store#swap iter upiter)
-			       with _ -> ()
-		      ));
-  let get_data () =
-    let start_path = GtkTree.TreePath.from_string "0" in
-    let start_iter = store#get_iter start_path in
-    let rec all acc =
-      let new_acc = (store#get ~row:start_iter ~column:command_col,
-		     store#get ~row:start_iter ~column:coq_col)::acc
-      in
-      if store#iter_next start_iter then all new_acc else List.rev new_acc
-    in all []
-  in
-  (hbox,get_data)
-
diff --git a/ide/utils/okey.ml b/ide/utils/okey.ml
deleted file mode 100644
index 8f6cb382a..000000000
--- a/ide/utils/okey.ml
+++ /dev/null
@@ -1,169 +0,0 @@
-(*********************************************************************************)
-(*                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 *)
-
-let int_of_modifier = function
-    `SHIFT -> 1
-  | `LOCK -> 2
-  | `CONTROL -> 4
-  | `MOD1 -> 8
-  | `MOD2 -> 16
-  | `MOD3 -> 32
-  | `MOD4 -> 64
-  | `MOD5 -> 128
-  | `BUTTON1 -> 256
-  | `BUTTON2 -> 512
-  | `BUTTON3 -> 1024
-  | `BUTTON4 -> 2048
-  | `BUTTON5 -> 4096
-  | `HYPER -> 1 lsl 22
-  | `META -> 1 lsl 20
-  | `RELEASE -> 1 lsl 30
-  | `SUPER -> 1 lsl 21
-
-let int_of_modifiers l =
-  List.fold_left (fun acc -> fun m -> acc + (int_of_modifier m)) 0 l
-
-module H =
-  struct
-    type t = handler_spec * handler
-    let equal (m,k) (mods, mask, key) =
-      (k = key) && ((m land mask) = mods)
-
-    let filter_with_mask mods mask key l =
-      List.filter (fun a -> (fst a) <> (mods, mask, key)) l
-
-    let find_handlers mods key l =
-      List.map snd
-        (List.filter
-	   (fun ((m,ma,k),_) -> equal (mods,key) (m,ma,k))
-	   l
-	)
-
-  end
-
-let (table : (int, H.t list ref) Hashtbl.t) = Hashtbl.create 13
-
-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 (Oo.id w) in
-    let l = H.find_handlers (int_of_modifiers modifiers) key !r in
-    match l with
-      [] -> false
-    | _ ->
-	List.iter
-	  (fun h ->
-	    if h.cond () then
-	      try h.cback ()
-	      with e -> Minilib.log (Printexc.to_string e)
-	    else ()
-	  )
-	  l;
-	true
-  with
-    Not_found ->
-      false
-
-let associate_key_press w =
-  ignore ((w#event#connect#key_press ~callback: (key_press w)) : GtkSignal.id)
-
-let default_modifiers = ref ([] : modifier list)
-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 ; ..>) () =
-  try
-    let r = Hashtbl.find table (Oo.id w) in
-    r := []
-  with
-    Not_found ->
-      ()
-
-let add1 ?(remove=false) w
-    ?(cond=(fun () -> true))
-    ?(mods= !default_modifiers)
-    ?(mask= !default_mask)
-    k callback =
-
-  let r =
-    try Hashtbl.find table (Oo.id w)
-    with Not_found ->
-      let r = ref [] in
-      Hashtbl.add table (Oo.id w) r;
-      ignore (w#connect#destroy ~callback: (remove_widget w));
-      associate_key_press w;
-      r
-  in
-  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
-    (
-     let l = H.filter_with_mask n_mods n_mask k !r in
-     r := ((n_mods, n_mask, k), new_h) :: l
-    )
-  else
-    r := ((n_mods, n_mask, k), new_h) :: !r
-
-let add w
-    ?(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))
-    ?(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))
-    ?(mods= !default_modifiers)
-    ?(mask= !default_mask)
-    k callback =
-  add1 ~remove: true w ~cond ~mods ~mask k callback
-
-let set_list w
-    ?(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
deleted file mode 100644
index 84ea4df44..000000000
--- a/ide/utils/okey.mli
+++ /dev/null
@@ -1,115 +0,0 @@
-(*********************************************************************************)
-(*                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.
-
-   Once the lib is compiled and installed, you can use it by referencing
-   it with the [Okey] module. You must add [okey.cmo] or [okey.cmx]
-   on the commande line when you link.
-*)
-
-type modifier = Gdk.Tags.modifier
-
-(** Set the default modifier list. The first default value is [[]].*)
-val set_default_modifiers : modifier list -> unit
-
-(** Set the default modifier mask. The first default value is
-   [[`MOD2 ; `MOD3 ; `MOD4 ; `MOD5 ; `LOCK]].
-   The mask defines the modifiers not taken into account
-   when looking for the handler of a key press event.
-*)
-val set_default_mask : modifier list -> unit
-
-(** [add widget key callback] associates the [callback] function to the event
-   "key_press" with the given [key] for the given [widget].
-
-   @param remove when true, the previous handlers for the given key and modifier
-   list are not kept.
-   @param cond this function is a guard: the [callback] function is not called
-   if the [cond] function returns [false].
-   The default [cond] function always returns [true].
-
-   @param mods the list of modifiers. If not given, the default modifiers
-   are used.
-   You can set the default modifiers with function {!Okey.set_default_modifiers}.
-
-   @param mask the list of modifiers which must not be taken
-   into account to trigger the given handler. [mods]
-   and [mask] must not have common modifiers. If not given, the default mask
-   is used.
-   You can set the default modifiers mask with function {!Okey.set_default_mask}.
-*)
-val add :
-    < connect : < destroy : callback: (unit -> unit) -> GtkSignal.id; .. >;
-      event : GObj.event_ops; get_oid : int; .. > ->
-	?cond: (unit -> bool) ->
-	  ?mods: modifier list ->
-	    ?mask: modifier list ->
-	      Gdk.keysym ->
-		(unit -> unit) ->
-		  unit
-
-(** It calls {!Okey.add} for each given key.*)
-val add_list :
-    < connect : < destroy : callback: (unit -> unit) -> GtkSignal.id; .. >;
-      event : GObj.event_ops; get_oid : int; .. > ->
-	?cond: (unit -> bool) ->
-	  ?mods: modifier list ->
-	    ?mask: modifier list ->
-	      Gdk.keysym list ->
-		(unit -> unit) ->
-		  unit
-
-(** Like {!Okey.add} but the previous handlers for the
-   given modifiers and key are not kept.*)
-val set :
-    < connect : < destroy : callback: (unit -> unit) -> GtkSignal.id; .. >;
-      event : GObj.event_ops; get_oid : int; .. > ->
-	?cond: (unit -> bool) ->
-	  ?mods: modifier list ->
-	    ?mask: modifier list ->
-	      Gdk.keysym ->
-		(unit -> unit) ->
-		  unit
-
-(** It calls {!Okey.set} for each given key.*)
-val set_list :
-    < connect : < destroy : callback: (unit -> unit) -> GtkSignal.id; .. >;
-      event : GObj.event_ops; get_oid : int; .. > ->
-	?cond: (unit -> bool) ->
-	  ?mods: modifier list ->
-	    ?mask: modifier list ->
-	      Gdk.keysym list ->
-		(unit -> unit) ->
-		  unit
-
-(** Remove the handlers associated to the given widget.
-   This is automatically done when a widget is destroyed but
-   you can do it yourself. *)
-val remove_widget :
-    < connect : < destroy : callback: (unit -> unit) -> GtkSignal.id; .. >;
-      event : GObj.event_ops; get_oid : int; .. > ->
-	unit ->
-	  unit
diff --git a/ide/wg_MessageView.ml b/ide/wg_MessageView.ml
index 758f383d6..0330b8eff 100644
--- a/ide/wg_MessageView.ml
+++ b/ide/wg_MessageView.ml
@@ -43,6 +43,7 @@ let message_view () : message_view =
     ~tag_table:Tags.Message.table ()
   in
   let text_buffer = new GText.buffer buffer#as_buffer in
+  let mark = buffer#create_mark ~left_gravity:false buffer#start_iter in
   let box = GPack.vbox () in
   let scroll = GBin.scrolled_window
     ~vpolicy:`AUTOMATIC ~hpolicy:`AUTOMATIC ~packing:(box#pack ~expand:true) () in
@@ -69,7 +70,8 @@ let message_view () : message_view =
       new message_view_signals_impl box#as_widget push
 
     method clear =
-      buffer#set_text ""
+      buffer#set_text "";
+      buffer#move_mark (`MARK mark) ~where:buffer#start_iter
 
     method push level msg =
       let tags = match level with
@@ -83,8 +85,9 @@ let message_view () : message_view =
       | Xml_datatype.Element (_, _, children) -> List.exists non_empty children
       in
       if non_empty (Richpp.repr msg) then begin
-        Ideutils.insert_xml buffer ~tags msg;
-        buffer#insert (*~tags*) "\n";
+        let mark = `MARK mark in
+        Ideutils.insert_xml ~mark buffer ~tags msg;
+        buffer#insert ~iter:(buffer#get_iter_at_mark mark) "\n";
         push#call (level, msg)
       end
 
diff --git a/lib/xml_lexer.mli b/ide/xml_lexer.mli
index e61cb055f..e61cb055f 100644
--- a/lib/xml_lexer.mli
+++ b/ide/xml_lexer.mli
diff --git a/lib/xml_lexer.mll b/ide/xml_lexer.mll
index 290f2c89a..290f2c89a 100644
--- a/lib/xml_lexer.mll
+++ b/ide/xml_lexer.mll
diff --git a/lib/xml_parser.ml b/ide/xml_parser.ml
index 8db3f9e8b..8db3f9e8b 100644
--- a/lib/xml_parser.ml
+++ b/ide/xml_parser.ml
diff --git a/lib/xml_parser.mli b/ide/xml_parser.mli
index ac2eab352..ac2eab352 100644
--- a/lib/xml_parser.mli
+++ b/ide/xml_parser.mli
diff --git a/lib/xml_printer.ml b/ide/xml_printer.ml
index e7e4d0ceb..40ab4ce9c 100644
--- a/lib/xml_printer.ml
+++ b/ide/xml_printer.ml
@@ -17,65 +17,65 @@ type t = target
 let make x = x
 
 let buffer_pcdata tmp text =
-  let output = Buffer.add_string tmp in
-  let output' = Buffer.add_char tmp in
+  let puts = Buffer.add_string tmp in
+  let putc = Buffer.add_char tmp in
   let l = String.length text in
   for p = 0 to l-1 do
     match text.[p] with
-      | ' ' -> output "&nbsp;";
-      | '>' -> output "&gt;"
-      | '<' -> output "&lt;"
+      | ' ' -> puts "&nbsp;";
+      | '>' -> puts "&gt;"
+      | '<' -> puts "&lt;"
       | '&' ->
         if p < l - 1 && text.[p + 1] = '#' then
-          output' '&'
+          putc '&'
         else
-          output "&amp;"
-      | '\'' -> output "&apos;"
-      | '"' -> output "&quot;"
-      | c -> output' c
+          puts "&amp;"
+      | '\'' -> puts "&apos;"
+      | '"' -> puts "&quot;"
+      | c -> putc c
   done
 
 let buffer_attr tmp (n,v) =
-  let output = Buffer.add_string tmp in
-  let output' = Buffer.add_char tmp in
-  output' ' ';
-  output n;
-  output "=\"";
+  let puts = Buffer.add_string tmp in
+  let putc = Buffer.add_char tmp in
+  putc ' ';
+  puts n;
+  puts "=\"";
   let l = String.length v in
   for p = 0 to l - 1 do
     match v.[p] with
-      | '\\' -> output "\\\\"
-      | '"' -> output "\\\""
-      | '<' -> output "&lt;"
-      | '&' -> output "&amp;"
-      | c -> output' c
+      | '\\' -> puts "\\\\"
+      | '"' -> puts "\\\""
+      | '<' -> puts "&lt;"
+      | '&' -> puts "&amp;"
+      | c -> putc c
   done;
-  output' '"'
+  putc '"'
 
 let to_buffer tmp x =
   let pcdata = ref false in
-  let output = Buffer.add_string tmp in
-  let output' = Buffer.add_char tmp in
+  let puts = Buffer.add_string tmp in
+  let putc = Buffer.add_char tmp in
   let rec loop = function
     | Element (tag,alist,[]) ->
-      output' '<';
-      output tag;
+      putc '<';
+      puts tag;
       List.iter (buffer_attr tmp) alist;
-      output "/>";
+      puts "/>";
       pcdata := false;
     | Element (tag,alist,l) ->
-      output' '<';
-      output tag;
+      putc '<';
+      puts tag;
       List.iter (buffer_attr tmp) alist;
-      output' '>';
+      putc '>';
       pcdata := false;
       List.iter loop l;
-      output "</";
-      output tag;
-      output' '>';
+      puts "</";
+      puts tag;
+      putc '>';
       pcdata := false;
     | PCData text ->
-      if !pcdata then output' ' ';
+      if !pcdata then putc ' ';
       buffer_pcdata tmp text;
       pcdata := true;
   in
@@ -93,42 +93,42 @@ let to_string x =
 
 let to_string_fmt x =
   let tmp = Buffer.create 200 in
-  let output = Buffer.add_string tmp in
-  let output' = Buffer.add_char tmp in
+  let puts = Buffer.add_string tmp in
+  let putc = Buffer.add_char tmp in
   let rec loop ?(newl=false) tab = function
     | Element (tag, alist, []) ->
-      output tab;
-      output' '<';
-      output tag;
+      puts tab;
+      putc '<';
+      puts tag;
       List.iter (buffer_attr tmp) alist;
-      output "/>";
-      if newl then output' '\n';
+      puts "/>";
+      if newl then putc '\n';
     | Element (tag, alist, [PCData text]) ->
-      output tab;
-      output' '<';
-      output tag;
+      puts tab;
+      putc '<';
+      puts tag;
       List.iter (buffer_attr tmp) alist;
-      output ">";
+      puts ">";
       buffer_pcdata tmp text;
-      output "</";
-      output tag;
-      output' '>';
-      if newl then output' '\n';
+      puts "</";
+      puts tag;
+      putc '>';
+      if newl then putc '\n';
     | Element (tag, alist, l) ->
-      output tab;
-      output' '<';
-      output tag;
+      puts tab;
+      putc '<';
+      puts tag;
       List.iter (buffer_attr tmp) alist;
-      output ">\n";
+      puts ">\n";
       List.iter (loop ~newl:true (tab^"  ")) l;
-      output tab;
-      output "</";
-      output tag;
-      output' '>';
-      if newl then output' '\n';
+      puts tab;
+      puts "</";
+      puts tag;
+      putc '>';
+      if newl then putc '\n';
     | PCData text ->
       buffer_pcdata tmp text;
-      if newl then output' '\n';
+      if newl then putc '\n';
   in
   loop "" x;
   Buffer.contents tmp
diff --git a/lib/xml_printer.mli b/ide/xml_printer.mli
index f24f51fff..f24f51fff 100644
--- a/lib/xml_printer.mli
+++ b/ide/xml_printer.mli
diff --git a/ide/xmlprotocol.ml b/ide/xmlprotocol.ml
index 232630e5b..5f82a8898 100644
--- a/ide/xmlprotocol.ml
+++ b/ide/xmlprotocol.ml
@@ -39,7 +39,7 @@ let to_search_cst = do_match "search_cst" (fun s args -> match s with
   | "subtype_pattern" -> SubType_Pattern (to_string (singleton args))
   | "in_module" -> In_Module (to_list to_string (singleton args))
   | "include_blacklist" -> Include_Blacklist
-  | _ -> raise Marshal_error)
+  | x -> raise (Marshal_error("search",PCData x)))
 
 let of_coq_object f ans =
   let prefix = of_list of_string ans.coq_object_prefix in
@@ -56,7 +56,7 @@ let to_coq_object f = function
     coq_object_qualid = qualid;
     coq_object_object = obj;
   }
-| _ -> raise Marshal_error
+| x -> raise (Marshal_error("coq_object",x))
 
 let of_option_value = function
   | IntValue i -> constructor "option_value" "intvalue" [of_option of_int i]
@@ -68,7 +68,7 @@ let to_option_value = do_match "option_value" (fun s args -> match s with
   | "boolvalue" -> BoolValue (to_bool (singleton args))
   | "stringvalue" -> StringValue (to_string (singleton args))
   | "stringoptvalue" -> StringOptValue (to_option to_string (singleton args))
-  | _ -> raise Marshal_error)
+  | x -> raise (Marshal_error("*value",PCData x)))
 
 let of_option_state s =
   Element ("option_state", [], [
@@ -82,8 +82,20 @@ let to_option_state = function
       opt_depr = to_bool depr;
       opt_name = to_string name;
       opt_value = to_option_value value }
-  | _ -> raise Marshal_error
+  | x -> raise (Marshal_error("option_state",x))
 
+let to_stateid = function
+  | Element ("state_id",["val",i],[]) ->
+      let id = int_of_string i in
+      Stateid.of_int id
+  | _ -> raise (Invalid_argument "to_state_id")
+
+let of_stateid i = Element ("state_id",["val",string_of_int (Stateid.to_int i)],[])
+
+let of_richpp x = Element ("richpp", [], [Richpp.repr x])
+let to_richpp xml = match xml with
+  | Element ("richpp", [], [x]) -> Richpp.richpp_of_xml x
+  | x -> raise Serialize.(Marshal_error("richpp",x))
 
 let of_value f = function
 | Good x -> Element ("value", ["val", "good"], [f x])
@@ -91,8 +103,9 @@ let of_value f = function
   let loc = match loc with
   | None -> []
   | Some (s, e) -> [("loc_s", string_of_int s); ("loc_e", string_of_int e)] in
-  let id = Stateid.to_xml id in
-  Element ("value", ["val", "fail"] @ loc, [id; Richpp.of_richpp msg])
+  let id = of_stateid id in
+  Element ("value", ["val", "fail"] @ loc, [id; of_richpp msg])
+
 let to_value f = function
 | Element ("value", attrs, l) ->
   let ans = massoc "val" attrs in
@@ -103,14 +116,14 @@ let to_value f = function
         let loc_s = int_of_string (Serialize.massoc "loc_s" attrs) in
         let loc_e = int_of_string (Serialize.massoc "loc_e" attrs) in
         Some (loc_s, loc_e)
-      with Marshal_error | Failure _ -> None
+      with Marshal_error _ | Failure _ -> None
     in
-    let (id, msg) = match l with [id; msg] -> (id, msg) | _ -> raise Marshal_error in
-    let id = Stateid.of_xml id in
-    let msg = Richpp.to_richpp msg in
+    let (id, msg) = match l with [id; msg] -> (id, msg) | _ -> raise (Marshal_error("val",PCData "no id attribute")) in
+    let id = to_stateid id in
+    let msg = to_richpp msg in
     Fail (id, loc, msg)
-  else raise Marshal_error
-| _ -> raise Marshal_error
+  else raise (Marshal_error("good or fail",PCData ans))
+| x -> raise (Marshal_error("value",x))
 
 let of_status s =
   let of_so = of_option of_string in
@@ -126,25 +139,25 @@ let to_status = function
       status_proofname = to_option to_string name;
       status_allproofs = to_list to_string prfs;
       status_proofnum = to_int pnum; }
-  | _ -> raise Marshal_error
+  | x -> raise (Marshal_error("status",x))
 
 let of_evar s = Element ("evar", [], [PCData s.evar_info])
 let to_evar = function
   | Element ("evar", [], data) -> { evar_info = raw_string data; }
-  | _ -> raise Marshal_error
+  | x -> raise (Marshal_error("evar",x))
 
 let of_goal g =
-  let hyp = of_list Richpp.of_richpp g.goal_hyp in
-  let ccl = Richpp.of_richpp g.goal_ccl in
+  let hyp = of_list of_richpp g.goal_hyp in
+  let ccl = of_richpp g.goal_ccl in
   let id = of_string g.goal_id in
   Element ("goal", [], [id; hyp; ccl])
 let to_goal = function
   | Element ("goal", [], [id; hyp; ccl]) ->
-    let hyp = to_list Richpp.to_richpp hyp in
-    let ccl = Richpp.to_richpp ccl in
+    let hyp = to_list to_richpp hyp in
+    let ccl = to_richpp ccl in
     let id = to_string id in
     { goal_hyp = hyp; goal_ccl = ccl; goal_id = id; }
-  | _ -> raise Marshal_error
+  | x -> raise (Marshal_error("goal",x))
 
 let of_goals g =
   let of_glist = of_list of_goal in
@@ -162,7 +175,7 @@ let to_goals = function
     let given_up = to_list to_goal given_up in
     { fg_goals = fg; bg_goals = bg; shelved_goals = shelf;
       given_up_goals = given_up }
-  | _ -> raise Marshal_error
+  | x -> raise (Marshal_error("goals",x))
 
 let of_coq_info info =
   let version = of_string info.coqtop_version in
@@ -176,7 +189,7 @@ let to_coq_info = function
       protocol_version = to_string protocol;
       release_date = to_string release;
       compile_date = to_string compile; }
-  | _ -> raise Marshal_error
+  | x -> raise (Marshal_error("coq_info",x))
 
 end
 include Xml_marshalling
@@ -286,7 +299,7 @@ end = struct
       | Coq_object t  -> (of_coq_object (convert t))
       | Pair (t1,t2)  -> (of_pair (convert t1) (convert t2))
       | Union (t1,t2) -> (of_union (convert t1) (convert t2))
-      | State_id      -> Stateid.to_xml
+      | State_id      -> of_stateid
       | Search_cst    -> of_search_cst
     in
       convert ty
@@ -309,7 +322,7 @@ end = struct
       | Coq_object t  -> (to_coq_object (convert t))
       | Pair (t1,t2)  -> (to_pair (convert t1) (convert t2))
       | Union (t1,t2) -> (to_union (convert t1) (convert t2))
-      | State_id      -> Stateid.of_xml
+      | State_id      -> to_stateid
       | Search_cst    -> to_search_cst
     in
       convert ty
@@ -422,7 +435,7 @@ end = struct
       (pr_xml (of_bool true)) (pr_xml (of_bool false));
     Printf.printf "%s:\n\n%s\n\n" (print_val_t String) (pr_xml (of_string "hello"));
     Printf.printf "%s:\n\n%s\n\n" (print_val_t Int) (pr_xml (of_int 256));
-    Printf.printf "%s:\n\n%s\n\n" (print_val_t State_id) (pr_xml (Stateid.to_xml Stateid.initial));
+    Printf.printf "%s:\n\n%s\n\n" (print_val_t State_id) (pr_xml (of_stateid Stateid.initial));
     Printf.printf "%s:\n\n%s\n\n" (print_val_t (List Int)) (pr_xml (of_list of_int [3;4;5]));
     Printf.printf "%s:\n\n%s\n%s\n\n" (print_val_t (Option Int))
       (pr_xml (of_option of_int (Some 3))) (pr_xml (of_option of_int None));
@@ -594,7 +607,7 @@ let abstract_eval_call : type a. _ -> a call -> a value = fun handler c ->
     | PrintAst x   -> mkGood (handler.print_ast x)
     | Annotate x   -> mkGood (handler.annotate x)
   with any ->
-    let any = Errors.push any in
+    let any = CErrors.push any in
     Fail (handler.handle_exn any)
 
 (** brain dead code, edit if protocol messages are added/removed *)
@@ -682,7 +695,7 @@ let to_call : xml -> unknown_call =
     | "StopWorker" -> Unknown (StopWorker (mkCallArg stop_worker_sty_t a))
     | "PrintAst"   -> Unknown (PrintAst   (mkCallArg print_ast_sty_t   a))
     | "Annotate"   -> Unknown (Annotate   (mkCallArg annotate_sty_t    a))
-    | _ -> raise Marshal_error)
+    | x -> raise (Marshal_error("call",PCData x)))
 
 (** Debug printing *)
 
@@ -750,4 +763,127 @@ let document to_string_fmt =
       (Fail (Stateid.initial,Some (15,34),Richpp.richpp_of_string "error message"))));
   document_type_encoding to_string_fmt
 
+(* Moved from feedback.mli : This is IDE specific and we don't want to
+   pollute the core with it *)
+
+open Feedback
+
+let of_message_level = function
+  | Debug ->
+      Serialize.constructor "message_level" "debug" []
+  | Info -> Serialize.constructor "message_level" "info" []
+  | Notice -> Serialize.constructor "message_level" "notice" []
+  | Warning -> Serialize.constructor "message_level" "warning" []
+  | Error -> Serialize.constructor "message_level" "error" []
+let to_message_level =
+  Serialize.do_match "message_level" (fun s args -> match s with
+  | "debug" -> Debug
+  | "info" -> Info
+  | "notice" -> Notice
+  | "warning" -> Warning
+  | "error" -> Error
+  | x -> raise Serialize.(Marshal_error("error level",PCData x)))
+
+let of_message lvl loc msg =
+  let lvl     = of_message_level lvl in
+  let xloc    = of_option of_loc loc in
+  let content = of_richpp msg        in
+  Xml_datatype.Element ("message", [], [lvl; xloc; content])
+
+let to_message xml = match xml with
+  | Xml_datatype.Element ("message", [], [lvl; xloc; content]) ->
+      Message(to_message_level lvl, to_option to_loc xloc, to_richpp content)
+  | x -> raise (Marshal_error("message",x))
+
+let is_message xml =
+  try begin match to_message xml with
+    | Message(l,c,m) -> Some (l,c,m)
+    | _              -> None
+  end with | Marshal_error _ -> None
+
+let to_feedback_content = do_match "feedback_content" (fun s a -> match s,a with
+  | "addedaxiom", _ -> AddedAxiom
+  | "processed", _ -> Processed
+  | "processingin", [where] -> ProcessingIn (to_string where)
+  | "incomplete", _ -> Incomplete
+  | "complete", _ -> Complete
+  | "globref", [loc; filepath; modpath; ident; ty] ->
+       GlobRef(to_loc loc, to_string filepath,
+         to_string modpath, to_string ident, to_string ty)
+  | "globdef", [loc; ident; secpath; ty] ->
+       GlobDef(to_loc loc, to_string ident, to_string secpath, to_string ty)
+  | "inprogress", [n] -> InProgress (to_int n)
+  | "workerstatus", [ns] ->
+       let n, s = to_pair to_string to_string ns in
+       WorkerStatus(n,s)
+  | "custom", [loc;name;x]-> Custom (to_loc loc, to_string name, x)
+  | "filedependency", [from; dep] ->
+      FileDependency (to_option to_string from, to_string dep)
+  | "fileloaded", [dirpath; filename] ->
+      FileLoaded (to_string dirpath, to_string filename)
+  | "message", [x] -> to_message x
+  | x,l -> raise (Marshal_error("feedback_content",PCData (x ^ " with attributes " ^ string_of_int (List.length l)))))
+
+let of_feedback_content = function
+  | AddedAxiom -> constructor "feedback_content" "addedaxiom" []
+  | Processed -> constructor "feedback_content" "processed" []
+  | ProcessingIn where ->
+      constructor "feedback_content" "processingin" [of_string where]
+  | Incomplete -> constructor "feedback_content" "incomplete" []
+  | Complete -> constructor "feedback_content" "complete" []
+  | GlobRef(loc, filepath, modpath, ident, ty) ->
+      constructor "feedback_content" "globref" [
+        of_loc loc;
+        of_string filepath;
+        of_string modpath;
+        of_string ident;
+        of_string ty ]
+  | GlobDef(loc, ident, secpath, ty) ->
+      constructor "feedback_content" "globdef" [
+        of_loc loc;
+        of_string ident;
+        of_string secpath;
+        of_string ty ]
+  | InProgress n -> constructor "feedback_content" "inprogress" [of_int n]
+  | WorkerStatus(n,s) ->
+      constructor "feedback_content" "workerstatus"
+        [of_pair of_string of_string (n,s)]
+  | Custom (loc, name, x) ->
+      constructor "feedback_content" "custom" [of_loc loc; of_string name; x]
+  | FileDependency (from, depends_on) ->
+      constructor "feedback_content" "filedependency" [
+        of_option of_string from;
+        of_string depends_on]
+  | FileLoaded (dirpath, filename) ->
+      constructor "feedback_content" "fileloaded" [
+        of_string dirpath;
+        of_string filename ]
+  | Message (l,loc,m) -> constructor "feedback_content" "message" [ of_message l loc m ]
+
+let of_edit_or_state_id = function
+  | Edit id -> ["object","edit"], of_edit_id id
+  | State id -> ["object","state"], of_stateid id
+
+let of_feedback msg =
+  let content = of_feedback_content msg.contents in
+  let obj, id = of_edit_or_state_id msg.id in
+  let route = string_of_int msg.route in
+  Element ("feedback", obj @ ["route",route], [id;content])
+
+let to_feedback xml = match xml with
+  | Element ("feedback", ["object","edit";"route",route], [id;content]) -> {
+      id = Edit(to_edit_id id);
+      route = int_of_string route;
+      contents = to_feedback_content content }
+  | Element ("feedback", ["object","state";"route",route], [id;content]) -> { 
+      id = State(to_stateid id);
+      route = int_of_string route;
+      contents = to_feedback_content content }
+  | x -> raise (Marshal_error("feedback",x))
+
+let is_feedback = function
+  | Element ("feedback", _, _) -> true
+  | _ -> false
+
 (* vim: set foldmethod=marker: *)
+
diff --git a/ide/xmlprotocol.mli b/ide/xmlprotocol.mli
index 265a50c47..1bb998970 100644
--- a/ide/xmlprotocol.mli
+++ b/ide/xmlprotocol.mli
@@ -56,3 +56,17 @@ val document : (xml -> string) -> unit
 val pr_call : 'a call -> string
 val pr_value : 'a value -> string
 val pr_full_value : 'a call -> 'a value -> string
+
+(** * Serialization of rich documents *)
+val of_richpp : Richpp.richpp -> Xml_datatype.xml
+val to_richpp : Xml_datatype.xml -> Richpp.richpp
+
+(** * Serializaiton of feedback  *)
+val of_feedback : Feedback.feedback -> xml
+val to_feedback : xml -> Feedback.feedback
+val is_feedback : xml -> bool
+
+val is_message : xml -> (Feedback.level * Loc.t option * Richpp.richpp) option
+val of_message : Feedback.level -> Loc.t option -> Richpp.richpp -> xml
+(* val to_message : xml -> Feedback.message *)
+
diff --git a/interp/constrarg.ml b/interp/constrarg.ml
deleted file mode 100644
index 011b31d9a..000000000
--- a/interp/constrarg.ml
+++ /dev/null
@@ -1,71 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-open Loc
-open Tacexpr
-open Misctypes
-open Genarg
-open Geninterp
-
-let make0 ?dyn name =
-  let wit = Genarg.make0 name in
-  let () = Geninterp.register_val0 wit dyn in
-  wit
-
-(** This is a hack for now, to break the dependency of Genarg on constr-related
-    types. We should use dedicated functions someday. *)
-
-let loc_of_or_by_notation f = function
-  | AN c -> f c
-  | ByNotation (loc,s,_) -> loc
-
-let wit_int_or_var =
-  make0 ~dyn:(val_tag (topwit Stdarg.wit_int)) "int_or_var"
-
-let wit_intro_pattern : (Constrexpr.constr_expr intro_pattern_expr located, glob_constr_and_expr intro_pattern_expr located, intro_pattern) genarg_type =
-  make0 "intropattern"
-
-let wit_tactic : (raw_tactic_expr, glob_tactic_expr, Val.t) genarg_type =
-  make0 "tactic"
-
-let wit_ltac = make0 ~dyn:(val_tag (topwit Stdarg.wit_unit)) "ltac"
-
-let wit_ident =
-  make0 "ident"
-
-let wit_var =
-  make0 ~dyn:(val_tag (topwit wit_ident)) "var"
-
-let wit_ref = make0 "ref"
-
-let wit_quant_hyp = make0 "quant_hyp"
-
-let wit_constr =
-  make0 "constr"
-
-let wit_uconstr = make0 "uconstr"
-
-let wit_open_constr = make0 ~dyn:(val_tag (topwit wit_constr)) "open_constr"
-
-let wit_constr_with_bindings = make0 "constr_with_bindings"
-
-let wit_bindings = make0 "bindings"
-
-let wit_red_expr = make0 "redexpr"
-
-let wit_clause_dft_concl  =
-  make0 "clause_dft_concl"
-
-(** Aliases *)
-
-let wit_reference = wit_ref
-let wit_global = wit_ref
-let wit_clause = wit_clause_dft_concl
-let wit_quantified_hypothesis = wit_quant_hyp
-let wit_intropattern = wit_intro_pattern
-let wit_redexpr = wit_red_expr
diff --git a/interp/constrarg.mli b/interp/constrarg.mli
deleted file mode 100644
index 70c9c0de2..000000000
--- a/interp/constrarg.mli
+++ /dev/null
@@ -1,82 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-(** Generic arguments based on [constr]. We put them here to avoid a dependency
-    of Genarg in [constr]-related interfaces. *)
-
-open Loc
-open Names
-open Term
-open Libnames
-open Globnames
-open Genredexpr
-open Pattern
-open Constrexpr
-open Tacexpr
-open Misctypes
-open Genarg
-
-(** FIXME: nothing to do there. *)
-val loc_of_or_by_notation : ('a -> Loc.t) -> 'a or_by_notation -> Loc.t
-
-(** {5 Additional generic arguments} *)
-
-val wit_int_or_var : (int or_var, int or_var, int) genarg_type
-
-val wit_intro_pattern : (constr_expr intro_pattern_expr located, glob_constr_and_expr intro_pattern_expr located, intro_pattern) genarg_type
-
-val wit_ident : Id.t uniform_genarg_type
-
-val wit_var : (Id.t located, Id.t located, Id.t) genarg_type
-
-val wit_ref : (reference, global_reference located or_var, global_reference) genarg_type
-
-val wit_quant_hyp : quantified_hypothesis uniform_genarg_type
-
-val wit_constr : (constr_expr, glob_constr_and_expr, constr) genarg_type
-
-val wit_uconstr : (constr_expr , glob_constr_and_expr, Glob_term.closed_glob_constr) genarg_type
-
-val wit_open_constr :
-  (constr_expr, glob_constr_and_expr, constr) genarg_type
-
-val wit_constr_with_bindings :
-  (constr_expr with_bindings,
-  glob_constr_and_expr with_bindings,
-  constr with_bindings delayed_open) genarg_type
-
-val wit_bindings :
-  (constr_expr bindings,
-  glob_constr_and_expr bindings,
-  constr bindings delayed_open) genarg_type
-
-val wit_red_expr :
-  ((constr_expr,reference or_by_notation,constr_expr) red_expr_gen,
-  (glob_constr_and_expr,evaluable_global_reference and_short_name or_var,glob_constr_pattern_and_expr) red_expr_gen,
-  (constr,evaluable_global_reference,constr_pattern) red_expr_gen) genarg_type
-
-val wit_tactic : (raw_tactic_expr, glob_tactic_expr, Geninterp.Val.t) genarg_type
-
-(** [wit_ltac] is subtly different from [wit_tactic]: they only change for their
-    toplevel interpretation. The one of [wit_ltac] forces the tactic and
-    discards the result. *)
-val wit_ltac : (raw_tactic_expr, glob_tactic_expr, unit) genarg_type
-
-val wit_clause_dft_concl :  (Names.Id.t Loc.located Locus.clause_expr,Names.Id.t Loc.located Locus.clause_expr,Names.Id.t Locus.clause_expr) genarg_type
-
-(** Aliases for compatibility *)
-
-val wit_reference : (reference, global_reference located or_var, global_reference) genarg_type
-val wit_global : (reference, global_reference located or_var, global_reference) genarg_type
-val wit_clause :  (Names.Id.t Loc.located Locus.clause_expr,Names.Id.t Loc.located Locus.clause_expr,Names.Id.t Locus.clause_expr) genarg_type
-val wit_quantified_hypothesis : quantified_hypothesis uniform_genarg_type
-val wit_intropattern : (constr_expr intro_pattern_expr located, glob_constr_and_expr intro_pattern_expr located, intro_pattern) genarg_type
-val wit_redexpr :
-  ((constr_expr,reference or_by_notation,constr_expr) red_expr_gen,
-  (glob_constr_and_expr,evaluable_global_reference and_short_name or_var,glob_constr_pattern_and_expr) red_expr_gen,
-  (constr,evaluable_global_reference,constr_pattern) red_expr_gen) genarg_type
diff --git a/interp/constrexpr_ops.ml b/interp/constrexpr_ops.ml
index c5730e626..59c24900d 100644
--- a/interp/constrexpr_ops.ml
+++ b/interp/constrexpr_ops.ml
@@ -40,7 +40,7 @@ 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)
+  List.flatten (List.map (function LocalRawAssum(l,_,_)->l|LocalRawDef(l,_)->[l]|LocalPattern _ -> assert false) bl)
 
 (**********************************************************************)
 (* Functions on constr_expr *)
@@ -260,6 +260,7 @@ let cases_pattern_expr_loc = function
   | CPatRecord (loc, _) -> loc
   | CPatPrim (loc,_) -> loc
   | CPatDelimiters (loc,_,_) -> loc
+  | CPatCast(loc,_,_) -> loc
 
 let raw_cases_pattern_expr_loc = function
   | RCPatAlias (loc,_,_) -> loc
@@ -271,6 +272,7 @@ let local_binder_loc = function
   | LocalRawAssum ((loc,_)::_,_,t)
   | LocalRawDef ((loc,_),t) -> Loc.merge loc (constr_loc t)
   | LocalRawAssum ([],_,_) -> assert false
+  | LocalPattern (loc,_,_) -> loc
 
 let local_binders_loc bll = match bll with
   | [] -> Loc.ghost
@@ -292,23 +294,74 @@ let mkAppC (f,l) =
   | CApp (_,g,l') -> CApp (Loc.ghost, g, l' @ l)
   | _ -> CApp (Loc.ghost, (None, f), l)
 
-let rec mkCProdN loc bll c =
-  match bll with
-  | LocalRawAssum ((loc1,_)::_ as idl,bk,t) :: bll ->
-      CProdN (loc,[idl,bk,t],mkCProdN (Loc.merge loc1 loc) bll c)
-  | LocalRawDef ((loc1,_) as id,b) :: bll ->
-      CLetIn (loc,id,b,mkCProdN (Loc.merge loc1 loc) bll c)
-  | [] -> c
-  | LocalRawAssum ([],_,_) :: bll -> mkCProdN loc bll c
-
-let rec mkCLambdaN loc bll c =
-  match bll with
-  | LocalRawAssum ((loc1,_)::_ as idl,bk,t) :: bll ->
-      CLambdaN (loc,[idl,bk,t],mkCLambdaN (Loc.merge loc1 loc) bll c)
-  | LocalRawDef ((loc1,_) as id,b) :: bll ->
-      CLetIn (loc,id,b,mkCLambdaN (Loc.merge loc1 loc) bll c)
-  | [] -> c
-  | LocalRawAssum ([],_,_) :: bll -> mkCLambdaN loc bll c
+let add_name_in_env env n =
+  match snd n with
+  | Anonymous -> env
+  | Name id -> id :: env
+
+let (fresh_var, fresh_var_hook) = Hook.make ~default:(fun _ _ -> assert false) ()
+
+let expand_pattern_binders mkC bl c =
+  let rec loop bl c =
+    match bl with
+    | [] -> ([], [], c)
+    | b :: bl ->
+        let (env, bl, c) = loop bl c in
+        match b with
+        | LocalRawDef (n, _) ->
+            let env = add_name_in_env env n in
+            (env, b :: bl, c)
+        | LocalRawAssum (nl, _, _) ->
+            let env = List.fold_left add_name_in_env env nl in
+            (env, b :: bl, c)
+        | LocalPattern (loc, p, ty) ->
+            let ni = Hook.get fresh_var env c in
+            let id = (loc, Name ni) in
+            let b =
+              LocalRawAssum
+                ([id], Default Explicit,
+                 match ty with
+                 | Some ty -> ty
+                 | None -> CHole (loc, None, IntroAnonymous, None))
+            in
+            let e = CRef (Libnames.Ident (loc, ni), None) in
+            let c =
+              CCases
+                (loc, LetPatternStyle, None, [(e,None,None)],
+                 [(loc, [(loc,[p])], mkC loc bl c)])
+            in
+            (ni :: env, [b], c)
+  in
+  let (_, bl, c) = loop bl c in
+  (bl, c)
+
+let mkCProdN loc bll c =
+  let rec loop loc bll c =
+    match bll with
+    | LocalRawAssum ((loc1,_)::_ as idl,bk,t) :: bll ->
+        CProdN (loc,[idl,bk,t],loop (Loc.merge loc1 loc) bll c)
+    | LocalRawDef ((loc1,_) as id,b) :: bll ->
+        CLetIn (loc,id,b,loop (Loc.merge loc1 loc) bll c)
+    | [] -> c
+    | LocalRawAssum ([],_,_) :: bll -> loop loc bll c
+    | LocalPattern (loc,p,ty) :: bll -> assert false
+  in
+  let (bll, c) = expand_pattern_binders loop bll c in
+  loop loc bll c
+
+let mkCLambdaN loc bll c =
+  let rec loop loc bll c =
+    match bll with
+    | LocalRawAssum ((loc1,_)::_ as idl,bk,t) :: bll ->
+        CLambdaN (loc,[idl,bk,t],loop (Loc.merge loc1 loc) bll c)
+    | LocalRawDef ((loc1,_) as id,b) :: bll ->
+        CLetIn (loc,id,b,loop (Loc.merge loc1 loc) bll c)
+    | [] -> c
+    | LocalRawAssum ([],_,_) :: bll -> loop loc bll c
+    | LocalPattern (loc,p,ty) :: bll -> assert false
+  in
+  let (bll, c) = expand_pattern_binders loop bll c in
+  loop loc bll c
 
 let rec abstract_constr_expr c = function
   | [] -> c
@@ -316,6 +369,7 @@ let rec abstract_constr_expr c = function
   | LocalRawAssum (idl,bk,t)::bl ->
       List.fold_right (fun x b -> mkLambdaC([x],bk,t,b)) idl
       (abstract_constr_expr c bl)
+  | LocalPattern _::_ -> assert false
 
 let rec prod_constr_expr c = function
   | [] -> c
@@ -323,22 +377,23 @@ let rec prod_constr_expr c = function
   | LocalRawAssum (idl,bk,t)::bl ->
       List.fold_right (fun x b -> mkProdC([x],bk,t,b)) idl
       (prod_constr_expr c bl)
+  | LocalPattern _::_ -> assert false
 
 let coerce_reference_to_id = function
   | Ident (_,id) -> id
   | Qualid (loc,_) ->
-      Errors.user_err_loc (loc, "coerce_reference_to_id",
-        str "This expression should be a simple identifier.")
+      CErrors.user_err ~loc ~hdr:"coerce_reference_to_id"
+        (str "This expression should be a simple identifier.")
 
 let coerce_to_id = function
   | CRef (Ident (loc,id),_) -> (loc,id)
-  | a -> Errors.user_err_loc
-        (constr_loc a,"coerce_to_id",
-         str "This expression should be a simple identifier.")
+  | a -> CErrors.user_err ~loc:(constr_loc a)
+       ~hdr:"coerce_to_id"
+         (str "This expression should be a simple identifier.")
 
 let coerce_to_name = function
   | CRef (Ident (loc,id),_) -> (loc,Name id)
   | CHole (loc,_,_,_) -> (loc,Anonymous)
-  | a -> Errors.user_err_loc
-        (constr_loc a,"coerce_to_name",
-         str "This expression should be a name.")
+  | a -> CErrors.user_err
+         ~loc:(constr_loc a) ~hdr:"coerce_to_name"
+         (str "This expression should be a name.")
diff --git a/interp/constrexpr_ops.mli b/interp/constrexpr_ops.mli
index 3f5be4855..a92da035f 100644
--- a/interp/constrexpr_ops.mli
+++ b/interp/constrexpr_ops.mli
@@ -58,6 +58,11 @@ val mkCLambdaN : Loc.t -> local_binder list -> constr_expr -> constr_expr
 val mkCProdN : Loc.t -> local_binder list -> constr_expr -> constr_expr
 (** Same as [prod_constr_expr], with location *)
 
+val fresh_var_hook : (Names.Id.t list -> Constrexpr.constr_expr -> Names.Id.t) Hook.t
+val expand_pattern_binders :
+  (Loc.t -> local_binder list -> constr_expr -> constr_expr) ->
+  local_binder list -> constr_expr -> local_binder list * constr_expr
+
 (** {6 Destructors}*)
 
 val coerce_reference_to_id : reference -> Id.t
diff --git a/interp/constrextern.ml b/interp/constrextern.ml
index e5ccb76b4..3077231be 100644
--- a/interp/constrextern.ml
+++ b/interp/constrextern.ml
@@ -8,7 +8,7 @@
 
 (*i*)
 open Pp
-open Errors
+open CErrors
 open Util
 open Names
 open Nameops
@@ -94,8 +94,8 @@ let is_record indsp =
 let encode_record r =
   let indsp = global_inductive r in
   if not (is_record indsp) then
-    user_err_loc (loc_of_reference r,"encode_record",
-    str "This type is not a structure type.");
+    user_err ~loc:(loc_of_reference r) ~hdr:"encode_record"
+      (str "This type is not a structure type.");
   indsp
 
 module PrintingRecordRecord =
@@ -149,17 +149,8 @@ let extern_evar loc n l = CEvar (loc,n,l)
     For instance, in the debugger the tables of global references
     may be inaccurate *)
 
-let safe_shortest_qualid_of_global vars r =
-  try shortest_qualid_of_global vars r
-  with Not_found ->
-    match r with
-    | VarRef v -> make_qualid DirPath.empty v
-    | ConstRef c -> make_qualid DirPath.empty Names.(Label.to_id (con_label c))
-    | IndRef (i,_) | ConstructRef ((i,_),_) ->
-        make_qualid DirPath.empty Names.(Label.to_id (mind_label i))
-
 let default_extern_reference loc vars r =
-  Qualid (loc,safe_shortest_qualid_of_global vars r)
+  Qualid (loc,shortest_qualid_of_global vars r)
 
 let my_extern_reference = ref default_extern_reference
 
@@ -481,15 +472,15 @@ let explicitize loc inctx impl (cf,f) args =
           (!print_implicits && !print_implicits_explicit_args) ||
           (is_needed_for_correct_partial_application tail imp) ||
 	  (!print_implicits_defensive &&
-	   is_significant_implicit a &&
-	   not (is_inferable_implicit inctx n imp))
+	   (not (is_inferable_implicit inctx n imp) || !Flags.beautify) &&
+	   is_significant_implicit (Lazy.force a))
 	in
         if visible then
-	  (a,Some (Loc.ghost, ExplByName (name_of_implicit imp))) :: tail
+	  (Lazy.force a,Some (Loc.ghost, 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*)
+    | a::args, _::impl -> (Lazy.force a,None) :: exprec (q+1) (args,impl)
+    | args, [] -> List.map (fun a -> (Lazy.force a,None)) args (*In case of polymorphism*)
     | [], (imp :: _) when is_status_implicit imp && maximal_insertion_of imp -> 
       (* The non-explicit application cannot be parsed back with the same type *)
       raise Expl
@@ -516,7 +507,7 @@ let explicitize loc inctx impl (cf,f) args =
     with Expl -> 
       let f',us = match f with CRef (f,us) -> f,us | _ -> assert false in
       let ip = if !print_projections then ip else None in
-	CAppExpl (loc, (ip, f', us), args)
+	CAppExpl (loc, (ip, f', us), List.map Lazy.force args)
 
 let is_start_implicit = function
   | imp :: _ -> is_status_implicit imp && maximal_insertion_of imp
@@ -538,19 +529,21 @@ let extern_app loc inctx impl (cf,f) us args =
       (!print_implicits && not !print_implicits_explicit_args)) &&
      List.exists is_status_implicit impl)
   then
+    let args = List.map Lazy.force args in
     CAppExpl (loc, (is_projection (List.length args) cf,f,us), args)
   else
     explicitize loc inctx impl (cf,CRef (f,us)) args
 
-let rec extern_args extern scopes env args subscopes =
-  match args with
-    | [] -> []
-    | a::args ->
-	let argscopes, subscopes = match subscopes with
-	  | [] -> (None,scopes), []
-	  | scopt::subscopes -> (scopt,scopes), subscopes in
-	extern argscopes env a :: extern_args extern scopes env args subscopes
+let rec fill_arg_scopes args subscopes scopes = match args, subscopes with
+| [], _ -> []
+| a :: args, scopt :: subscopes ->
+  (a, (scopt, scopes)) :: fill_arg_scopes args subscopes scopes
+| a :: args, [] ->
+  (a, (None, scopes)) :: fill_arg_scopes args [] scopes
 
+let extern_args extern env args =
+  let map (arg, argscopes) = lazy (extern argscopes env arg) in
+  List.map map args
 
 let match_coercion_app = function
   | GApp (loc,GRef (_,r,_),args) -> Some (loc, r, 0, args)
@@ -647,8 +640,7 @@ let rec extern inctx scopes vars r =
       (match f with
 	 | GRef (rloc,ref,us) ->
 	     let subscopes = find_arguments_scope ref in
-	     let args =
-	       extern_args (extern true) (snd scopes) vars args subscopes in
+	     let args = fill_arg_scopes args subscopes (snd scopes) in
 	     begin
 	       try
                  if !Flags.raw_print then raise Exit;
@@ -683,12 +675,14 @@ let rec extern inctx scopes vars r =
 			       match args with
 				 | [] -> raise No_match
 				     (* we give up since the constructor is not complete *)
-				 | head :: tail -> ip q locs' tail
-				     ((extern_reference loc Id.Set.empty (ConstRef c), head) :: acc)
+				 | (arg, scopes) :: tail ->
+                                     let head = extern true scopes vars arg in
+				     ip q locs' tail ((extern_reference loc Id.Set.empty (ConstRef c), head) :: acc)
 		   in
 		 CRecord (loc, List.rev (ip projs locals args []))
 	       with
 		 | Not_found | No_match | Exit ->
+                    let args = extern_args (extern true) vars args in
 		     extern_app loc inctx
 		       (select_stronger_impargs (implicits_of_global ref))
 		       (Some ref,extern_reference rloc vars ref) (extern_universes us) args
@@ -696,7 +690,7 @@ let rec extern inctx scopes vars r =
 	       
 	 | _       ->
 	   explicitize loc inctx [] (None,sub_extern false scopes vars f)
-             (List.map (sub_extern true scopes vars) args))
+             (List.map (fun c -> lazy (sub_extern true scopes vars c)) args))
 
   | GLetIn (loc,na,t,c) ->
       CLetIn (loc,(loc,na),sub_extern false scopes vars t,
@@ -762,6 +756,7 @@ let rec extern inctx scopes vars r =
 	     let listdecl =
 	       Array.mapi (fun i fi ->
                  let (bl,ty,def) = blv.(i), tyv.(i), bv.(i) in
+                 let bl = List.map (fun (p,bk,x,t) -> (Inl p,bk,x,t)) bl in
                  let (assums,ids,bl) = extern_local_binder scopes vars bl in
                  let vars0 = List.fold_right (name_fold Id.Set.add) ids vars in
                  let vars1 = List.fold_right (name_fold Id.Set.add) ids vars' in
@@ -778,7 +773,8 @@ let rec extern inctx scopes vars r =
 	 | GCoFix n ->
 	     let listdecl =
                Array.mapi (fun i fi ->
-                 let (_,ids,bl) = extern_local_binder scopes vars blv.(i) in
+                 let bl = List.map (fun (p,bk,x,t) -> (Inl p,bk,x,t)) blv.(i) in
+                 let (_,ids,bl) = extern_local_binder scopes vars bl in
                  let vars0 = List.fold_right (name_fold Id.Set.add) ids vars in
                  let vars1 = List.fold_right (name_fold Id.Set.add) ids vars' in
 		 ((Loc.ghost, fi),bl,extern_typ scopes vars0 tyv.(i),
@@ -821,13 +817,13 @@ and factorize_lambda inctx scopes vars na bk aty c =
 
 and extern_local_binder scopes vars = function
     [] -> ([],[],[])
-  | (na,bk,Some bd,ty)::l ->
+  | (Inl na,bk,Some bd,ty)::l ->
       let (assums,ids,l) =
         extern_local_binder scopes (name_fold Id.Set.add na vars) l in
       (assums,na::ids,
        LocalRawDef((Loc.ghost,na), extern false scopes vars bd) :: l)
 
-  | (na,bk,None,ty)::l ->
+  | (Inl na,bk,None,ty)::l ->
       let ty = extern_typ scopes vars ty in
       (match extern_local_binder scopes (name_fold Id.Set.add na vars) l with
           (assums,ids,LocalRawAssum(nal,k,ty')::l)
@@ -840,6 +836,15 @@ and extern_local_binder scopes vars = function
             (na::assums,na::ids,
              LocalRawAssum([(Loc.ghost,na)],Default bk,ty) :: l))
 
+  | (Inr p,bk,Some bd,ty)::l -> assert false
+
+  | (Inr p,bk,None,ty)::l ->
+      let ty =
+        if !Flags.raw_print then Some (extern_typ scopes vars ty) else None in
+      let p = extern_cases_pattern vars p in
+      let (assums,ids,l) = extern_local_binder scopes vars l in
+      (assums,ids, LocalPattern(Loc.ghost,p,ty) :: l)
+
 and extern_eqn inctx scopes vars (loc,ids,pl,c) =
   (loc,[loc,List.map (extern_cases_pattern_in_scope scopes vars) pl],
    extern inctx scopes vars c)
@@ -916,7 +921,8 @@ and extern_notation (tmp_scope,scopes as allscopes) vars t = function
 	      if List.is_empty l then a else CApp (loc,(None,a),l) in
  	if List.is_empty args then e
 	else
-	  let args = extern_args (extern true) scopes vars args argsscopes in
+	  let args = fill_arg_scopes args argsscopes scopes in
+	  let args = extern_args (extern true) vars args in
 	  explicitize loc false argsimpls (None,e) args
       with
 	  No_match -> extern_notation allscopes vars t rules
@@ -1046,4 +1052,5 @@ let extern_constr_pattern env sigma pat =
 let extern_rel_context where env sigma sign =
   let a = detype_rel_context where [] (names_of_rel_context env,env) sigma sign in
   let vars = vars_of_env env in
+  let a = List.map (fun (p,bk,x,t) -> (Inl p,bk,x,t)) a in
   pi3 (extern_local_binder (None,[]) vars a)
diff --git a/interp/constrintern.ml b/interp/constrintern.ml
index 50252a368..c102d8e11 100644
--- a/interp/constrintern.ml
+++ b/interp/constrintern.ml
@@ -7,7 +7,7 @@
 (************************************************************************)
 
 open Pp
-open Errors
+open CErrors
 open Util
 open Names
 open Nameops
@@ -33,10 +33,10 @@ open Context.Rel.Declaration
 
 (** constr_expr -> glob_constr translation:
     - it adds holes for implicit arguments
-    - it remplaces notations by their value (scopes stuff are here)
+    - it replaces notations by their value (scopes stuff are here)
     - it recognizes global vars from local ones
-    - it prepares pattern maching problems (a pattern becomes a tree where nodes
-    are constructor/variable pairs and leafs are variables)
+    - it prepares pattern matching problems (a pattern becomes a tree
+      where nodes are constructor/variable pairs and leafs are variables)
 
     All that at once, fasten your seatbelt!
 *)
@@ -154,17 +154,17 @@ let explain_internalization_error e =
   | BadPatternsNumber (n1,n2) -> explain_bad_patterns_number n1 n2
   in pp ++ str "."
 
-let error_bad_inductive_type loc =
-  user_err_loc (loc,"",str
+let error_bad_inductive_type ?loc =
+  user_err ?loc  (str
     "This should be an inductive type applied to patterns.")
 
-let error_parameter_not_implicit loc =
-  user_err_loc (loc,"", str
+let error_parameter_not_implicit ?loc =
+  user_err ?loc  (str
    "The parameters do not bind in patterns;" ++ spc () ++ str
     "they must be replaced by '_'.")
 
-let error_ldots_var loc =
-  user_err_loc (loc,"",str "Special token " ++ pr_id ldots_var ++
+let error_ldots_var ?loc =
+  user_err ?loc  (str "Special token " ++ pr_id ldots_var ++
     str " is for use in the Notation command.")
 
 (**********************************************************************)
@@ -262,15 +262,15 @@ let pr_scope_stack = function
   | l -> str "scope stack " ++
       str "[" ++ prlist_with_sep pr_comma str l ++ str "]"
 
-let error_inconsistent_scope loc id scopes1 scopes2 =
-  user_err_loc (loc,"set_var_scope",
-    pr_id id ++ str " is here used in " ++
+let error_inconsistent_scope ?loc id scopes1 scopes2 =
+  user_err ?loc ~hdr:"set_var_scope"
+   (pr_id id ++ str " is here used in " ++
     pr_scope_stack scopes2 ++ strbrk " while it was elsewhere used in " ++
     pr_scope_stack scopes1)
 
-let error_expect_binder_notation_type loc id =
-  user_err_loc (loc,"",
-    pr_id id ++
+let error_expect_binder_notation_type ?loc id =
+  user_err ?loc 
+   (pr_id id ++
     str " is expected to occur in binding position in the right-hand side.")
 
 let set_var_scope loc id istermvar env ntnvars =
@@ -284,12 +284,12 @@ let set_var_scope loc id istermvar env ntnvars =
       | Some (tmp, scope) ->
         let s1 = make_current_scope tmp scope in
         let s2 = make_current_scope env.tmp_scope env.scopes in
-        if not (List.equal String.equal s1 s2) then error_inconsistent_scope loc id s1 s2
+        if not (List.equal String.equal s1 s2) then error_inconsistent_scope ~loc id s1 s2
       end
     in
     match typ with
     | NtnInternTypeBinder ->
-	if istermvar then error_expect_binder_notation_type loc id
+	if istermvar then error_expect_binder_notation_type ~loc id
     | NtnInternTypeConstr ->
 	(* We need sometimes to parse idents at a constr level for
 	   factorization and we cannot enforce this constraint:
@@ -366,20 +366,19 @@ let check_hidden_implicit_parameters id impls =
     | (Inductive indparams,_,_,_) -> Id.List.mem id indparams
     | _ -> false) impls
   then
-    errorlabstrm "" (strbrk "A parameter of an inductive type " ++
+    user_err  (strbrk "A parameter of an inductive type " ++
     pr_id id ++ strbrk " is not allowed to be used as a bound variable in the type of its constructor.")
 
-let push_name_env ?(global_level=false) lvar implargs env =
+let push_name_env ?(global_level=false) ntnvars implargs env =
   function
   | loc,Anonymous ->
       if global_level then
-	user_err_loc (loc,"", str "Anonymous variables not allowed");
+	user_err ~loc  (str "Anonymous variables not allowed");
       env
   | loc,Name id ->
       check_hidden_implicit_parameters id env.impls ;
-      let (_,ntnvars) = lvar in
       if Id.Map.is_empty ntnvars && Id.equal id ldots_var
-        then error_ldots_var loc;
+        then error_ldots_var ~loc;
       set_var_scope loc id false env ntnvars;
       if global_level then Dumpglob.dump_definition (loc,id) true "var"
       else Dumpglob.dump_binding loc id;
@@ -433,14 +432,72 @@ let intern_assumption intern lvar env nal bk ty =
      let env, b = intern_generalized_binder intern_type lvar env (List.hd nal) b b' t ty in
      env, b
 
+let rec free_vars_of_pat il =
+  function
+  | CPatCstr (loc, c, l1, l2) ->
+      let il = List.fold_left free_vars_of_pat il (Option.default [] l1) in
+      List.fold_left free_vars_of_pat il l2
+  | CPatAtom (loc, ro) ->
+      begin match ro with
+      | Some (Ident (loc, i)) -> (loc, i) :: il
+      | Some _ | None -> il
+      end
+  | CPatNotation (loc, n, l1, l2) ->
+      let il = List.fold_left free_vars_of_pat il (fst l1) in
+      List.fold_left (List.fold_left free_vars_of_pat) il (snd l1)
+  | _ -> anomaly (str "free_vars_of_pat")
+
+let intern_local_pattern intern lvar env p =
+  List.fold_left
+    (fun env (loc, i) ->
+       let bk = Default Implicit in
+       let ty = CHole (loc, None, Misctypes.IntroAnonymous, None) in
+       let n = Name i in
+       let env, _ = intern_assumption intern lvar env [(loc, n)] bk ty in
+       env)
+    env (free_vars_of_pat [] p)
+
+type binder_data =
+  | BDRawDef of (Loc.t * glob_binder)
+  | BDPattern of
+      (Loc.t * (cases_pattern * Id.t list) *
+         (bool ref *
+          (Notation_term.tmp_scope_name option *
+           Notation_term.tmp_scope_name list)
+          option ref * Notation_term.notation_var_internalization_type)
+         Names.Id.Map.t *
+       intern_env * constr_expr)
+
+let intern_cases_pattern_fwd = ref (fun _ -> failwith "intern_cases_pattern_fwd")
+
 let intern_local_binder_aux ?(global_level=false) intern lvar (env,bl) = function
   | LocalRawAssum(nal,bk,ty) ->
       let env, bl' = intern_assumption intern lvar env nal bk ty in
+      let bl' = List.map (fun a -> BDRawDef a) bl' in
       env, bl' @ bl
   | LocalRawDef((loc,na as locna),def) ->
-      let indef = intern env def in
+     let indef = intern env def in
+     let term, ty =
+       match indef with
+       | GCast (loc, b, Misctypes.CastConv t) -> b, t
+       | _ -> indef, GHole(loc,Evar_kinds.BinderType na,Misctypes.IntroAnonymous,None)
+     in
       (push_name_env lvar (impls_term_list indef) env locna,
-      (loc,(na,Explicit,Some(indef),GHole(loc,Evar_kinds.BinderType na,Misctypes.IntroAnonymous,None)))::bl)
+       (BDRawDef ((loc,(na,Explicit,Some(term),ty))))::bl)
+  | LocalPattern (loc,p,ty) ->
+      let tyc =
+        match ty with
+        | Some ty -> ty
+        | None -> CHole(loc,None,Misctypes.IntroAnonymous,None)
+      in
+      let env = intern_local_pattern intern lvar env p in
+      let cp =
+        match !intern_cases_pattern_fwd (None,env.scopes) p with
+        | (_, [(_, cp)]) -> cp
+        | _ -> assert false
+      in
+      let il = List.map snd (free_vars_of_pat [] p) in
+      (env, BDPattern(loc,(cp,il),lvar,env,tyc) :: bl)
 
 let intern_generalization intern env lvar loc bk ak c =
   let c = intern {env with unb = true} c in
@@ -509,44 +566,85 @@ let traverse_binder (terms,_,_ as subst) avoid (renaming,env) = function
     in
     (renaming',env), Name id'
 
-let make_letins = List.fold_right (fun (loc,(na,b,t)) c -> GLetIn (loc,na,b,c))
-
-let rec subordinate_letins letins = function
+type letin_param =
+  | LPLetIn of Loc.t * (Name.t * glob_constr)
+  | LPCases of Loc.t * (cases_pattern * Id.t list) * Id.t
+
+let make_letins =
+  List.fold_right
+    (fun a c ->
+     match a with
+     | LPLetIn (loc,(na,b)) ->
+         GLetIn(loc,na,b,c)
+     | LPCases (loc,(cp,il),id) ->
+         let tt = (GVar(loc,id),(Name id,None)) in
+         GCases(loc,Misctypes.LetPatternStyle,None,[tt],[(loc,il,[cp],c)]))
+
+let rec subordinate_letins intern letins = function
   (* binders come in reverse order; the non-let are returned in reverse order together *)
   (* with the subordinated let-in in writing order *)
-  | (loc,(na,_,Some b,t))::l ->
-      subordinate_letins ((loc,(na,b,t))::letins) l
-  | (loc,(na,bk,None,t))::l ->
-      let letins',rest = subordinate_letins [] l in
+  | BDRawDef (loc,(na,_,Some b,t))::l ->
+      subordinate_letins intern (LPLetIn (loc,(na,b))::letins) l
+  | BDRawDef (loc,(na,bk,None,t))::l ->
+      let letins',rest = subordinate_letins intern [] l in
       letins',((loc,(na,bk,t)),letins)::rest
+  | BDPattern (loc,u,lvar,env,tyc) :: l ->
+      let ienv = Id.Set.elements env.ids in
+      let id = Namegen.next_ident_away (Id.of_string "pat") ienv in
+      let na = (loc, Name id) in
+      let bk = Default Explicit in
+      let _, bl' = intern_assumption intern lvar env [na] bk tyc in
+      let bl' = List.map (fun a -> BDRawDef a) bl' in
+      subordinate_letins intern (LPCases (loc,u,id)::letins) (bl'@ l)
   | [] ->
       letins,[]
 
-let rec subst_iterator y t = function
-  | GVar (_,id) as x -> if Id.equal id y then t else x
-  | x -> map_glob_constr (subst_iterator y t) x
-
-let instantiate_notation_constr loc intern (_,ntnvars as lvar) subst infos c =
+let terms_of_binders bl =
+  let rec term_of_pat = function
+    | PatVar (loc,Name id) -> CRef (Ident (loc,id), None)
+    | PatVar (loc,Anonymous) -> error "Cannot turn \"_\" into a term."
+    | PatCstr (loc,c,l,_) ->
+       let r = Qualid (loc,qualid_of_path (path_of_global (ConstructRef c))) in
+       let hole = CHole (loc,None,Misctypes.IntroAnonymous,None) in
+       let params = List.make (Inductiveops.inductive_nparams (fst c)) hole in
+       CAppExpl (loc,(None,r,None),params @ List.map term_of_pat l) in
+  let rec extract_variables = function
+    | BDRawDef (loc,(Name id,_,None,_))::l -> CRef (Ident (loc,id), None) :: extract_variables l
+    | BDRawDef (loc,(Name id,_,Some _,_))::l -> extract_variables l
+    | BDRawDef (loc,(Anonymous,_,_,_))::l -> error "Cannot turn \"_\" into a term."
+    | BDPattern (loc,(u,_),lvar,env,tyc) :: l -> term_of_pat u :: extract_variables l
+    | [] -> [] in
+  extract_variables bl
+
+let instantiate_notation_constr loc intern ntnvars subst infos c =
   let (terms,termlists,binders) = subst in
   (* when called while defining a notation, avoid capturing the private binders
      of the expression by variables bound by the notation (see #3892) *)
   let avoid = Id.Map.domain ntnvars in
-  let rec aux (terms,binderopt as subst') (renaming,env) c =
+  let rec aux (terms,binderopt,terminopt as subst') (renaming,env) c =
     let subinfos = renaming,{env with tmp_scope = None} in
     match c with
+    | NVar id when Id.equal id ldots_var -> Option.get terminopt
     | NVar id -> subst_var subst' (renaming, env) id
-    | NList (x,_,iter,terminator,lassoc) ->
-      (try
+    | NList (x,y,iter,terminator,lassoc) ->
+      let l,(scopt,subscopes) =
         (* All elements of the list are in scopes (scopt,subscopes) *)
-	let (l,(scopt,subscopes)) = Id.Map.find x termlists in
-        let termin = aux subst' subinfos terminator in
-        let fold a t =
-          let nterms = Id.Map.add x (a, (scopt, subscopes)) terms in
-          subst_iterator ldots_var t (aux (nterms, binderopt) subinfos iter)
-        in
-	List.fold_right fold (if lassoc then List.rev l else l) termin
-      with Not_found ->
-          anomaly (Pp.str "Inconsistent substitution of recursive notation"))
+        try
+          let l,scopes = Id.Map.find x termlists in
+          (if lassoc then List.rev l else l),scopes
+        with Not_found ->
+        try
+	  let (bl,(scopt,subscopes)) = Id.Map.find x binders in
+	  let env,bl' = List.fold_left (intern_local_binder_aux intern ntnvars) (env,[]) bl in
+          terms_of_binders (if lassoc then bl' else List.rev bl'),(None,[])
+        with Not_found ->
+          anomaly (Pp.str "Inconsistent substitution of recursive notation") in
+      let termin = aux (terms,None,None) subinfos terminator in
+      let fold a t =
+        let nterms = Id.Map.add y (a, (scopt, subscopes)) terms in
+        aux (nterms,None,Some t) subinfos iter
+      in
+      List.fold_right fold l termin
     | NHole (knd, naming, arg) ->
       let knd = match knd with
       | Evar_kinds.BinderType (Name id as na) ->
@@ -562,45 +660,37 @@ let instantiate_notation_constr loc intern (_,ntnvars as lvar) subst infos c =
       let arg = match arg with
       | None -> None
       | Some arg ->
-        let open Tacexpr in
-        let open Genarg in
-        let wit = glbwit Constrarg.wit_tactic in
-        let body =
-          if has_type arg wit then out_gen wit arg
-          else assert false (** FIXME *)
-        in
-        let mk_env id (c, (tmp_scope, subscopes)) accu =
+        let mk_env (c, (tmp_scope, subscopes)) =
           let nenv = {env with tmp_scope; scopes = subscopes @ env.scopes} in
           let gc = intern nenv c in
-          let c = ConstrMayEval (Genredexpr.ConstrTerm (gc, Some c)) in
-          ((loc, id), c) :: accu
+          (gc, Some c)
         in
-        let bindings = Id.Map.fold mk_env terms [] in
-        let tac = TacLetIn (false, bindings, body) in
-        let arg = in_gen wit tac in
-        Some arg
+        let bindings = Id.Map.map mk_env terms in
+        Some (Genintern.generic_substitute_notation bindings arg)
       in
       GHole (loc, knd, naming, arg)
-    | NBinderList (x,_,iter,terminator) ->
+    | NBinderList (x,y,iter,terminator) ->
       (try
         (* All elements of the list are in scopes (scopt,subscopes) *)
 	let (bl,(scopt,subscopes)) = Id.Map.find x binders in
-	let env,bl = List.fold_left (intern_local_binder_aux intern lvar) (env,[]) bl in
-	let letins,bl = subordinate_letins [] bl in
-        let termin = aux subst' (renaming,env) terminator in
+	let env,bl = List.fold_left (intern_local_binder_aux intern ntnvars) (env,[]) bl in
+	let letins,bl = subordinate_letins intern [] bl in
+        let termin = aux (terms,None,None) (renaming,env) terminator in
 	let res = List.fold_left (fun t binder ->
-          subst_iterator ldots_var t
-	    (aux (terms,Some(x,binder)) subinfos iter))
+	    aux (terms,Some(y,binder),Some t) subinfos iter)
 	  termin bl in
 	make_letins letins res
       with Not_found ->
           anomaly (Pp.str "Inconsistent substitution of recursive notation"))
     | NProd (Name id, NHole _, c') when option_mem_assoc id binderopt ->
-        let (loc,(na,bk,t)),letins = snd (Option.get binderopt) in
-	GProd (loc,na,bk,t,make_letins letins (aux subst' infos c'))
+        let a,letins = snd (Option.get binderopt) in
+        let e = make_letins letins (aux subst' infos c') in
+        let (loc,(na,bk,t)) = a in
+        GProd (loc,na,bk,t,e)
     | NLambda (Name id,NHole _,c') when option_mem_assoc id binderopt ->
-        let (loc,(na,bk,t)),letins = snd (Option.get binderopt) in
-	GLambda (loc,na,bk,t,make_letins letins (aux subst' infos c'))
+        let a,letins = snd (Option.get binderopt) in
+        let (loc,(na,bk,t)) = a in
+        GLambda (loc,na,bk,t,make_letins letins (aux subst' infos c'))
     (* Two special cases to keep binder name synchronous with BinderType *)
     | NProd (na,NHole(Evar_kinds.BinderType na',naming,arg),c')
         when Name.equal na na' ->
@@ -615,7 +705,7 @@ let instantiate_notation_constr loc intern (_,ntnvars as lvar) subst infos c =
     | t ->
       glob_constr_of_notation_constr_with_binders loc
         (traverse_binder subst avoid) (aux subst') subinfos t
-  and subst_var (terms, binderopt) (renaming, env) id =
+  and subst_var (terms, _binderopt, _terminopt) (renaming, env) id =
     (* subst remembers the delimiters stack in the interpretation *)
     (* of the notations *)
     try
@@ -628,7 +718,7 @@ let instantiate_notation_constr loc intern (_,ntnvars as lvar) subst infos c =
     with Not_found ->
       (* Happens for local notation joint with inductive/fixpoint defs *)
       GVar (loc,id)
-  in aux (terms,None) infos c
+  in aux (terms,None,None) infos c
 
 let split_by_type ids =
   List.fold_right (fun (x,(scl,typ)) (l1,l2,l3) ->
@@ -661,7 +751,13 @@ let string_of_ty = function
   | Method -> "meth"
   | Variable -> "var"
 
-let intern_var genv (ltacvars,ntnvars) namedctx loc id =
+let gvar (loc, id) us = match us with
+| None -> GVar (loc, id)
+| Some _ ->
+  user_err ~loc  (str "Variable " ++ pr_id id ++
+    str " cannot have a universe instance")
+
+let intern_var genv (ltacvars,ntnvars) namedctx loc id us =
   (* Is [id] an inductive type potentially with implicit *)
   try
     let ty,expl_impls,impls,argsc = Id.Map.find id genv.impls in
@@ -669,25 +765,25 @@ let intern_var genv (ltacvars,ntnvars) namedctx loc id =
       (fun id -> CRef (Ident (loc,id),None), Some (loc,ExplByName id)) expl_impls in
     let tys = string_of_ty ty in
     Dumpglob.dump_reference loc "<>" (Id.to_string id) tys;
-    GVar (loc,id), make_implicits_list impls, argsc, expl_impls
+    gvar (loc,id) us, make_implicits_list impls, argsc, expl_impls
   with Not_found ->
   (* Is [id] bound in current term or is an ltac var bound to constr *)
   if Id.Set.mem id genv.ids || Id.Set.mem id ltacvars.ltac_vars
   then
-    GVar (loc,id), [], [], []
+    gvar (loc,id) us, [], [], []
   (* Is [id] a notation variable *)
   else if Id.Map.mem id ntnvars
   then
-    (set_var_scope loc id true genv ntnvars; GVar (loc,id), [], [], [])
+    (set_var_scope loc id true genv ntnvars; gvar (loc,id) us, [], [], [])
   (* Is [id] the special variable for recursive notations *)
   else if Id.equal id ldots_var
   then if Id.Map.is_empty ntnvars
-    then error_ldots_var loc
-    else GVar (loc,id), [], [], []
+    then error_ldots_var ~loc
+    else gvar (loc,id) us, [], [], []
   else if Id.Set.mem id ltacvars.ltac_bound then
     (* Is [id] bound to a free name in ltac (this is an ltac error message) *)
-    user_err_loc (loc,"intern_var",
-      str "variable " ++ pr_id id ++ str " should be bound to a term.")
+    user_err ~loc ~hdr:"intern_var"
+     (str "variable " ++ pr_id id ++ str " should be bound to a term.")
   else
     (* Is [id] a goal or section variable *)
     let _ = Context.Named.lookup id namedctx in
@@ -698,10 +794,10 @@ let intern_var genv (ltacvars,ntnvars) namedctx loc id =
 	let impls = implicits_of_global ref in
 	let scopes = find_arguments_scope ref in
 	Dumpglob.dump_reference loc "<>" (string_of_qualid (Decls.variable_secpath id)) "var";
-	GRef (loc, ref, None), impls, scopes, []
-      with e when Errors.noncritical e ->
+	GRef (loc, ref, us), impls, scopes, []
+      with e when CErrors.noncritical e ->
 	(* [id] a goal variable *)
-	GVar (loc,id), [], [], []
+	gvar (loc,id) us, [], [], []
 
 let find_appl_head_data c =
   match c with
@@ -719,7 +815,7 @@ let find_appl_head_data c =
   | x -> x,[],[],[]
 
 let error_not_enough_arguments loc =
-  user_err_loc (loc,"",str "Abbreviation is not applied enough.")
+  user_err ~loc  (str "Abbreviation is not applied enough.")
 
 let check_no_explicitation l =
   let is_unset (a, b) = match b with None -> false | Some _ -> true in
@@ -728,7 +824,7 @@ let check_no_explicitation l =
   | [] -> ()
   | (_, None) :: _ -> assert false
   | (_, Some (loc, _)) :: _ ->
-    user_err_loc (loc,"",str"Unexpected explicitation of the argument of an abbreviation.")
+    user_err ~loc  (str"Unexpected explicitation of the argument of an abbreviation.")
 
 let dump_extended_global loc = function
   | TrueGlobal ref -> (*feedback_global loc ref;*) Dumpglob.add_glob loc ref
@@ -741,7 +837,7 @@ let intern_reference ref =
   let qid = qualid_of_reference ref in
   let r =
     try intern_extended_global_of_qualid qid
-    with Not_found -> error_global_not_found_loc (fst qid) (snd qid)
+    with Not_found -> error_global_not_found ~loc:(fst qid) (snd qid)
   in
   Smartlocate.global_of_extended_global r
 
@@ -763,9 +859,12 @@ let intern_qualid loc qid intern env lvar us args =
       let c = match us, c with
       | None, _ -> c
       | Some _, GRef (loc, ref, None) -> GRef (loc, ref, us)
+      | Some _, GApp (loc, GRef (loc', ref, None), arg) ->
+         GApp (loc, GRef (loc', ref, us), arg)
       | Some _, _ ->
-        user_err_loc (loc, "", str "Notation " ++ pr_qualid qid ++
-          str " cannot have a universe instance")
+        user_err ~loc  (str "Notation " ++ pr_qualid qid ++
+          str " cannot have a universe instance, its expanded head
+               does not start with a reference")
       in
       c, projapp, args2
 
@@ -775,27 +874,27 @@ let intern_non_secvar_qualid loc qid intern env lvar us args =
     | GRef (_, VarRef _, _),_,_ -> raise Not_found
     | r -> r
 
-let intern_applied_reference intern env namedctx lvar us args = function
+let intern_applied_reference intern env namedctx (_, ntnvars as lvar) us args = function
   | Qualid (loc, qid) ->
       let r,projapp,args2 =
-	try intern_qualid loc qid intern env lvar us args
-	with Not_found -> error_global_not_found_loc loc qid
+	try intern_qualid loc qid intern env ntnvars us args
+	with Not_found -> error_global_not_found ~loc qid
       in
       let x, imp, scopes, l = find_appl_head_data r in
 	(x,imp,scopes,l), args2
   | Ident (loc, id) ->
-      try intern_var env lvar namedctx loc id, args
+      try intern_var env lvar namedctx loc id us, args
       with Not_found ->
       let qid = qualid_of_ident id in
       try
-	let r, projapp, args2 = intern_non_secvar_qualid loc qid intern env lvar us args in
+	let r, projapp, args2 = intern_non_secvar_qualid loc qid intern env ntnvars us args in
 	let x, imp, scopes, l = find_appl_head_data r in
 	  (x,imp,scopes,l), args2
       with Not_found ->
 	(* Extra allowance for non globalizing functions *)
 	if !interning_grammar || env.unb then
-	  (GVar (loc,id), [], [], []), args
-	else error_global_not_found_loc loc qid
+	  (gvar (loc,id) us, [], [], []), args
+	else error_global_not_found ~loc qid
 
 let interp_reference vars r =
   let (r,_,_,_),_ =
@@ -873,7 +972,7 @@ let check_number_of_pattern loc n l =
 
 let check_or_pat_variables loc ids idsl =
   if List.exists (fun ids' -> not (List.eq_set Id.equal ids ids')) idsl then
-    user_err_loc (loc, "", str
+    user_err ~loc  (str
     "The components of this disjunctive pattern must bind the same variables.")
 
 (** Use only when params were NOT asked to the user.
@@ -882,7 +981,7 @@ let check_constructor_length env loc cstr len_pl pl0 =
   let n = len_pl + List.length pl0 in
   if Int.equal n (Inductiveops.constructor_nallargs cstr) then false else
     (Int.equal n (Inductiveops.constructor_nalldecls cstr) ||
-      (error_wrong_numarg_constructor_loc loc env cstr
+      (error_wrong_numarg_constructor ~loc env cstr
          (Inductiveops.constructor_nrealargs cstr)))
 
 let add_implicits_check_length fail nargs nargs_with_letin impls_st len_pl1 pl2 =
@@ -907,14 +1006,14 @@ let add_implicits_check_constructor_length env loc c len_pl1 pl2 =
   let nargs = Inductiveops.constructor_nallargs c in
   let nargs' = Inductiveops.constructor_nalldecls c in
   let impls_st = implicits_of_global (ConstructRef c) in
-  add_implicits_check_length (error_wrong_numarg_constructor_loc loc env c)
+  add_implicits_check_length (error_wrong_numarg_constructor ~loc env c)
     nargs nargs' impls_st len_pl1 pl2
 
 let add_implicits_check_ind_length env loc c len_pl1 pl2 =
   let nallargs = inductive_nallargs_env env c in
   let nalldecls = inductive_nalldecls_env env c in
   let impls_st = implicits_of_global (IndRef c) in
-  add_implicits_check_length (error_wrong_numarg_inductive_loc loc env c)
+  add_implicits_check_length (error_wrong_numarg_inductive ~loc env c)
     nallargs nalldecls impls_st len_pl1 pl2
 
 (** Do not raise NotEnoughArguments thanks to preconditions*)
@@ -925,7 +1024,7 @@ let chop_params_pattern loc ind args with_letin =
   assert (nparams <= List.length args);
   let params,args = List.chop nparams args in
   List.iter (function PatVar(_,Anonymous) -> ()
-    | PatVar (loc',_) | PatCstr(loc',_,_,_) -> error_parameter_not_implicit loc') params;
+    | PatVar (loc',_) | PatCstr(loc',_,_,_) -> error_parameter_not_implicit ~loc:loc') params;
   args
 
 let find_constructor loc add_params ref =
@@ -933,10 +1032,10 @@ let find_constructor loc add_params ref =
   | ConstructRef cstr -> cstr
   | IndRef _ ->
     let error = str "There is an inductive name deep in a \"in\" clause." in
-    user_err_loc (loc, "find_constructor", error)
+    user_err ~loc ~hdr:"find_constructor" error
   | ConstRef _ | VarRef _ ->
     let error = str "This reference is not a constructor." in
-    user_err_loc (loc, "find_constructor", error)
+    user_err ~loc ~hdr:"find_constructor" error
   in
   cstr, match add_params with
     | Some nb_args ->
@@ -952,95 +1051,121 @@ let find_pattern_variable = function
   | Ident (loc,id) -> id
   | Qualid (loc,_) as x -> raise (InternalizationError(loc,NotAConstructor x))
 
-let sort_fields mode loc l completer =
-(*mode=false if pattern and true if constructor*)
-  match l with
+let check_duplicate loc fields =
+  let eq (ref1, _) (ref2, _) = eq_reference ref1 ref2 in
+  let dups = List.duplicates eq fields in
+  match dups with
+  | [] -> ()
+  | (r, _) :: _ ->
+    user_err ~loc (str "This record defines several times the field " ++
+      pr_reference r ++ str ".")
+
+(** [sort_fields ~complete loc fields completer] expects a list
+    [fields] of field assignments [f = e1; g = e2; ...], where [f, g]
+    are fields of a record and [e1] are "values" (either terms, when
+    interning a record construction, or patterns, when intering record
+    pattern-matching). It will sort the fields according to the record
+    declaration order (which is important when type-checking them in
+    presence of dependencies between fields). If the parameter
+    [complete] is true, we require the assignment to be complete: all
+    the fields of the record must be present in the
+    assignment. Otherwise the record assignment may be partial
+    (in a pattern, we may match on some fields only), and we call the
+    function [completer] to fill the missing fields; the returned
+    field assignment list is always complete. *)
+let sort_fields ~complete loc fields completer =
+  match fields with
     | [] -> None
-    | (refer, value)::rem ->
-	let (nparams,          (* the number of parameters *)
-	     base_constructor, (* the reference constructor of the record *)
-	     (max,             (* number of params *)
-	      (first_index,    (* index of the first field of the record *)
-	       list_proj)))    (* list of projections *)
-	  =
-	  let record =
-	    try Recordops.find_projection
-	      (global_reference_of_reference refer)
-	    with Not_found ->
-	      user_err_loc (loc_of_reference refer, "intern", pr_reference refer ++ str": Not a projection")
-	    in
-	  (* elimination of the first field from the projections *)
-	  let rec build_patt l m i acc =
-	    match l with
-	      | [] -> (i, acc)
-	      | (Some name) :: b->
-		 (match m with
-		    | [] -> anomaly (Pp.str "Number of projections mismatch")
-		    | (_, regular)::tm ->
-		       let boolean = not regular in
-                       begin match global_reference_of_reference refer with
-		       | ConstRef name' when eq_constant name name' ->
-			 if boolean && mode then
-			   user_err_loc (loc, "", str"No local fields allowed in a record construction.")
-			 else build_patt b tm (i + 1) (i, snd acc) (* we found it *)
-                       | _ ->
-			  build_patt b tm (if boolean&&mode then i else i + 1)
-			    (if boolean && mode then acc
-			     else fst acc, (i, ConstRef name) :: snd acc)
-                       end)
-	      | None :: b-> (* we don't want anonymous fields *)
-		 if mode then
-		   user_err_loc (loc, "", str "This record contains anonymous fields.")
-		 else build_patt b m (i+1) acc
-		   (* anonymous arguments don't appear in m *)
-	    in
-	  let ind = record.Recordops.s_CONST in
-	  try (* insertion of Constextern.reference_global *)
-	    (record.Recordops.s_EXPECTEDPARAM,
-	     Qualid (loc, shortest_qualid_of_global Id.Set.empty (ConstructRef ind)),
-	     build_patt record.Recordops.s_PROJ record.Recordops.s_PROJKIND 1 (0,[]))
-	  with Not_found -> anomaly (Pp.str "Environment corruption for records.")
-	  in
-	(* now we want to have all fields of the pattern indexed by their place in
-	   the constructor *)
-	let rec sf patts accpatt =
-	  match patts with
-	    | [] -> accpatt
-	    | p::q->
-	       let refer, patt = p in
-	       let glob_refer = try global_reference_of_reference refer
-	       with |Not_found ->
-		 user_err_loc (loc_of_reference refer, "intern",
-			       str "The field \"" ++ pr_reference refer ++ str "\" does not exist.") in
-	       let rec add_patt l acc =
-		 match l with
-		   | [] ->
-		       user_err_loc
-			 (loc, "",
-			  str "This record contains fields of different records.")
-		   | (i, a) :: b->
-		       if eq_gr glob_refer a
-		       then (i,List.rev_append acc l)
-		       else add_patt b ((i,a)::acc)
-	         in
-	       let (index, projs) = add_patt (snd accpatt) [] in
-		 sf q ((index, patt)::fst accpatt, projs) in
-	let (unsorted_indexed_pattern, remainings) =
-	  sf rem ([first_index, value], list_proj) in
-	(* we sort them *)
-	let sorted_indexed_pattern =
-	  List.sort (fun (i, _) (j, _) -> compare i j) unsorted_indexed_pattern in
-	(* a function to complete with wildcards *)
-	let rec complete_list n l =
-	  if n <= 1 then l else complete_list (n-1) (completer n l) in
-	(* a function to remove indice *)
-	let rec clean_list l i acc =
-	  match l with
-	    | [] -> complete_list (max - i) acc
-	    | (k, p)::q-> clean_list q k (p::(complete_list (k - i) acc))
-	  in
-	Some (nparams, base_constructor,
-	  List.rev (clean_list sorted_indexed_pattern 0 []))
+    | (first_field_ref, first_field_value):: other_fields ->
+        let (first_field_glob_ref, record) =
+          try
+            let gr = global_reference_of_reference first_field_ref in
+            (gr, Recordops.find_projection gr)
+          with Not_found ->
+            user_err ~loc:(loc_of_reference first_field_ref) ~hdr:"intern"
+                         (pr_reference first_field_ref ++ str": Not a projection")
+        in
+        (* the number of parameters *)
+        let nparams = record.Recordops.s_EXPECTEDPARAM in
+        (* the reference constructor of the record *)
+        let base_constructor =
+          let global_record_id = ConstructRef record.Recordops.s_CONST in
+          try Qualid (loc, shortest_qualid_of_global Id.Set.empty global_record_id)
+          with Not_found ->
+            anomaly (str "Environment corruption for records") in
+        let () = check_duplicate loc fields in
+        let (end_index,    (* one past the last field index *)
+             first_field_index,  (* index of the first field of the record *)
+             proj_list)    (* list of projections *)
+          =
+          (* elimitate the first field from the projections,
+             but keep its index *)
+          let rec build_proj_list projs proj_kinds idx ~acc_first_idx acc =
+            match projs with
+              | [] -> (idx, acc_first_idx, acc)
+              | (Some name) :: projs ->
+                 let field_glob_ref = ConstRef name in
+                 let first_field = eq_gr field_glob_ref first_field_glob_ref in
+                 begin match proj_kinds with
+                    | [] -> anomaly (Pp.str "Number of projections mismatch")
+                    | (_, regular) :: proj_kinds ->
+                       (* "regular" is false when the field is defined
+                           by a let-in in the record declaration
+                           (its value is fixed from other fields). *)
+                       if first_field && not regular && complete then
+                         user_err ~loc  (str "No local fields allowed in a record construction.")
+                       else if first_field then
+                         build_proj_list projs proj_kinds (idx+1) ~acc_first_idx:idx acc
+                       else if not regular && complete then
+                         (* skip non-regular fields *)
+                         build_proj_list projs proj_kinds idx ~acc_first_idx acc
+                       else
+                         build_proj_list projs proj_kinds (idx+1) ~acc_first_idx
+                                         ((idx, field_glob_ref) :: acc)
+                 end
+              | None :: projs ->
+                 if complete then
+                   (* we don't want anonymous fields *)
+                   user_err ~loc  (str "This record contains anonymous fields.")
+                 else
+                   (* anonymous arguments don't appear in proj_kinds *)
+                   build_proj_list projs proj_kinds (idx+1) ~acc_first_idx acc
+          in
+          build_proj_list record.Recordops.s_PROJ record.Recordops.s_PROJKIND 1 ~acc_first_idx:0 []
+        in
+        (* now we want to have all fields assignments indexed by their place in
+           the constructor *)
+        let rec index_fields fields remaining_projs acc =
+          match fields with
+            | (field_ref, field_value) :: fields ->
+               let field_glob_ref = try global_reference_of_reference field_ref
+               with Not_found ->
+                 user_err ~loc:(loc_of_reference field_ref) ~hdr:"intern"
+                               (str "The field \"" ++ pr_reference field_ref ++ str "\" does not exist.") in
+               let remaining_projs, (field_index, _) =
+                 let the_proj (idx, glob_ref) = eq_gr field_glob_ref glob_ref in
+                 try CList.extract_first the_proj remaining_projs
+                 with Not_found ->
+                   user_err ~loc 
+                     (str "This record contains fields of different records.")
+               in
+               index_fields fields remaining_projs ((field_index, field_value) :: acc)
+            | [] ->
+               (* the order does not matter as we sort them next,
+                  List.rev_* is just for efficiency *)
+               let remaining_fields =
+                 let complete_field (idx, _field_ref) = (idx, completer idx) in
+                 List.rev_map complete_field remaining_projs in
+               List.rev_append remaining_fields acc
+        in
+        let unsorted_indexed_fields =
+          index_fields other_fields proj_list
+            [(first_field_index, first_field_value)] in
+        let sorted_indexed_fields =
+          let cmp_by_index (i, _) (j, _) = Int.compare i j in
+          List.sort cmp_by_index unsorted_indexed_fields in
+        let sorted_fields = List.map snd sorted_indexed_fields in
+        Some (nparams, base_constructor, sorted_fields)
 
 (** {6 Manage multiple aliases} *)
 
@@ -1068,10 +1193,6 @@ let alias_of als = match als.alias_ids with
 | [] -> Anonymous
 | id :: _ -> Name id
 
-let message_redundant_alias id1 id2 =
-  Feedback.msg_warning
-    (str "Alias variable " ++ pr_id id1 ++ str " is merged with " ++ pr_id id2)
-
 (** {6 Expanding notations }
 
     @returns a raw_case_pattern_expr :
@@ -1097,7 +1218,7 @@ let drop_notations_pattern looked_for =
       if top then looked_for g else
       match g with ConstructRef _ -> () | _ -> raise Not_found
     with Not_found ->
-      error_invalid_pattern_notation loc
+      error_invalid_pattern_notation ~loc ()
   in
   let test_kind top =
     if top then looked_for else function ConstructRef _ -> () | _ -> raise Not_found
@@ -1140,7 +1261,7 @@ let drop_notations_pattern looked_for =
     | CPatAlias (loc, p, id) -> RCPatAlias (loc, in_pat top scopes p, id)
     | CPatRecord (loc, l) ->
       let sorted_fields =
-	sort_fields false loc l (fun _ l -> (CPatAtom (loc, None))::l) in
+	sort_fields ~complete:false loc l (fun _idx -> (CPatAtom (loc, None))) in
       begin match sorted_fields with
 	| None -> RCPatAtom (loc, None)
 	| Some (n, head, pl) ->
@@ -1195,6 +1316,8 @@ let drop_notations_pattern looked_for =
     | CPatAtom (loc,None) -> RCPatAtom (loc,None)
     | CPatOr (loc, pl) ->
       RCPatOr (loc,List.map (in_pat top scopes) pl)
+    | CPatCast _ ->
+      assert false
   and in_pat_sc scopes x = in_pat false (x,snd scopes)
   and in_not top loc scopes (subst,substlist as fullsubst) args = function
     | NVar id ->
@@ -1219,15 +1342,15 @@ let drop_notations_pattern looked_for =
       RCPatCstr (loc, g,
 		 List.map2 (fun x -> in_not false loc (x,snd scopes) fullsubst []) argscs1 pl @
 		 List.map (in_pat false scopes) args, [])
-    | NList (x,_,iter,terminator,lassoc) ->
-      if not (List.is_empty args) then user_err_loc
-        (loc,"",strbrk "Application of arguments to a recursive notation not supported in patterns.");
+    | NList (x,y,iter,terminator,lassoc) ->
+      if not (List.is_empty args) then user_err ~loc 
+        (strbrk "Application of arguments to a recursive notation not supported in patterns.");
       (try
          (* All elements of the list are in scopes (scopt,subscopes) *)
 	 let (l,(scopt,subscopes)) = Id.Map.find x substlist in
          let termin = in_not top loc scopes fullsubst [] terminator in
 	 List.fold_right (fun a t ->
-           let nsubst = Id.Map.add x (a, (scopt, subscopes)) subst in
+           let nsubst = Id.Map.add y (a, (scopt, subscopes)) subst in
            let u = in_not false loc scopes (nsubst, substlist) [] iter in
            subst_pat_iterator ldots_var t u)
            (if lassoc then List.rev l else l) termin
@@ -1236,7 +1359,7 @@ let drop_notations_pattern looked_for =
     | NHole _ ->
       let () = assert (List.is_empty args) in
       RCPatAtom (loc, None)
-    | t -> error_invalid_pattern_notation loc
+    | t -> error_invalid_pattern_notation ~loc ()
   in in_pat true
 
 let rec intern_pat genv aliases pat =
@@ -1276,19 +1399,57 @@ let rec intern_pat genv aliases pat =
       check_or_pat_variables loc ids (List.tl idsl);
       (ids,List.flatten pl')
 
+(* [check_no_patcast p] raises an error if [p] contains a cast. This code is a
+   bit ad-hoc, and is due to current restrictions on casts in patterns. We
+   support them only in local binders and only at top level. In fact, they are
+   currently eliminated by the parser. The only reason why they are in the
+   [cases_pattern_expr] type is that the parser needs to factor the "(c : t)"
+   notation with user defined notations (such as the pair). In the long term, we
+   will try to support such casts everywhere, and use them to print the domains
+   of lambdas in the encoding of match in constr. We put this check here and not
+   in the parser because it would require to duplicate the levels of the
+   [pattern] rule. *)
+let rec check_no_patcast = function
+  | CPatCast (loc,_,_) ->
+     CErrors.user_err ~loc ~hdr:"check_no_patcast"
+                           (Pp.strbrk "Casts are not supported here.")
+  | CPatDelimiters(_,_,p)
+  | CPatAlias(_,p,_) -> check_no_patcast p
+  | CPatCstr(_,_,opl,pl) ->
+     Option.iter (List.iter check_no_patcast) opl;
+     List.iter check_no_patcast pl
+  | CPatOr(_,pl) ->
+     List.iter check_no_patcast pl
+  | CPatNotation(_,_,subst,pl) ->
+     check_no_patcast_subst subst;
+     List.iter check_no_patcast pl
+  | CPatRecord(_,prl) ->
+     List.iter (fun (_,p) -> check_no_patcast p) prl
+  | CPatAtom _ | CPatPrim _ -> ()
+
+and check_no_patcast_subst (pl,pll) =
+  List.iter check_no_patcast pl;
+  List.iter (List.iter check_no_patcast) pll
+
 let intern_cases_pattern genv scopes aliases pat =
+  check_no_patcast pat;
   intern_pat genv aliases
     (drop_notations_pattern (function ConstructRef _ -> () | _ -> raise Not_found) scopes pat)
 
+let _ =
+  intern_cases_pattern_fwd :=
+    fun scopes p -> intern_cases_pattern (Global.env ()) scopes empty_alias p
+
 let intern_ind_pattern genv scopes pat =
+  check_no_patcast pat;
   let no_not =
     try
       drop_notations_pattern (function (IndRef _ | ConstructRef _) -> () | _ -> raise Not_found) scopes pat
-    with InternalizationError(loc,NotAConstructor _) -> error_bad_inductive_type loc
+    with InternalizationError(loc,NotAConstructor _) -> error_bad_inductive_type ~loc
   in
   match no_not with
     | RCPatCstr (loc, head, expl_pl, pl) ->
-      let c = (function IndRef ind -> ind | _ -> error_bad_inductive_type loc) head in
+      let c = (function IndRef ind -> ind | _ -> error_bad_inductive_type ~loc) head in
       let with_letin, pl2 = add_implicits_check_ind_length genv loc c
 	(List.length expl_pl) pl in
       let idslpl1 = List.rev_map (intern_pat genv empty_alias) expl_pl in
@@ -1296,8 +1457,8 @@ let intern_ind_pattern genv scopes pat =
       (with_letin,
        match product_of_cases_patterns [] (List.rev_append idslpl1 idslpl2) with
        | _,[_,pl] -> (c,chop_params_pattern loc c pl with_letin)
-       | _ -> error_bad_inductive_type loc)
-    | x -> error_bad_inductive_type (raw_cases_pattern_expr_loc x)
+       | _ -> error_bad_inductive_type ~loc)
+    | x -> error_bad_inductive_type ~loc:(raw_cases_pattern_expr_loc x)
 
 (**********************************************************************)
 (* Utilities for application                                          *)
@@ -1336,10 +1497,10 @@ let extract_explicit_arg imps args =
 	  let id = match pos with
 	  | ExplByName id ->
 	      if not (exists_implicit_name id imps) then
-		user_err_loc
-		  (loc,"",str "Wrong argument name: " ++ pr_id id ++ str ".");
+		user_err ~loc 
+		  (str "Wrong argument name: " ++ pr_id id ++ str ".");
 	      if Id.Map.mem id eargs then
-		user_err_loc (loc,"",str "Argument name " ++ pr_id id
+		user_err ~loc  (str "Argument name " ++ pr_id id
 		++ str " occurs more than once.");
 	      id
 	  | ExplByPos (p,_id) ->
@@ -1349,11 +1510,11 @@ let extract_explicit_arg imps args =
 		  if not (is_status_implicit imp) then failwith "imp";
 		  name_of_implicit imp
 		with Failure _ (* "nth" | "imp" *) ->
-		  user_err_loc
-		    (loc,"",str"Wrong argument position: " ++ int p ++ str ".")
+		  user_err ~loc 
+		    (str"Wrong argument position: " ++ int p ++ str ".")
 	      in
 	      if Id.Map.mem id eargs then
-		user_err_loc (loc,"",str"Argument at position " ++ int p ++
+		user_err ~loc  (str"Argument at position " ++ int p ++
 		  str " is mentioned more than once.");
 	      id in
 	  (Id.Map.add id (loc, a) eargs, rargs)
@@ -1362,7 +1523,7 @@ let extract_explicit_arg imps args =
 (**********************************************************************)
 (* Main loop                                                          *)
 
-let internalize globalenv env allow_patvar lvar c =
+let internalize globalenv env allow_patvar (_, ntnvars as lvar) c =
   let rec intern env = function
     | CRef (ref,us) as x ->
 	let (c,imp,subscopes,l),_ =
@@ -1383,10 +1544,11 @@ let internalize globalenv env allow_patvar lvar c =
           (fun (id,(n,order),bl,ty,_) ->
 	     let intern_ro_arg f =
 	       let before, after = split_at_annot bl n in
-	       let (env',rbefore) =
-		 List.fold_left intern_local_binder (env,[]) before in
+	       let (env',rbefore) = List.fold_left intern_local_binder (env,[]) before in
+               let rbefore = List.map (function BDRawDef a -> a | BDPattern _ -> assert false) rbefore in
 	       let ro = f (intern env') in
 	       let n' = Option.map (fun _ -> List.count (fun (_,(_,_,b,_)) -> (* remove let-ins *) b = None) rbefore) n in
+               let rbefore = List.map (fun a -> BDRawDef a) rbefore in
 		 n', ro, List.fold_left intern_local_binder (env',rbefore) after
 	     in
 	     let n, ro, (env',rbl) =
@@ -1398,12 +1560,18 @@ let internalize globalenv env allow_patvar lvar c =
 	       | CMeasureRec (m,r) ->
 		   intern_ro_arg (fun f -> GMeasureRec (f m, Option.map f r))
 	     in
-	       ((n, ro), List.rev rbl, intern_type env' ty, env')) dl in
+	     let bl =
+               List.rev_map
+                 (function
+                  | BDRawDef a -> a
+                  | BDPattern (loc,_,_,_,_) ->
+                      Loc.raise ~loc (Stream.Error "pattern with quote not allowed after fix")) rbl in
+	       ((n, ro), bl, intern_type env' ty, env')) dl in
         let idl = Array.map2 (fun (_,_,_,_,bd) (a,b,c,env') ->
 	     let env'' = List.fold_left_i (fun i en name -> 
 					     let (_,bli,tyi,_) = idl_temp.(i) in
 					     let fix_args = (List.map (fun (_,(na, bk, _, _)) -> (build_impls bk na)) bli) in
-					       push_name_env lvar (impls_type_list ~args:fix_args tyi)
+					       push_name_env ntnvars (impls_type_list ~args:fix_args tyi)
 					    en (Loc.ghost, Name name)) 0 env' lf in
              (a,b,c,intern {env'' with tmp_scope = None} bd)) dl idl_temp in
 	GRec (loc,GFix
@@ -1422,15 +1590,15 @@ let internalize globalenv env allow_patvar lvar c =
 	in
         let idl_tmp = Array.map
           (fun ((loc,id),bl,ty,_) ->
-            let (env',rbl) =
-              List.fold_left intern_local_binder (env,[]) bl in
+            let (env',rbl) = List.fold_left intern_local_binder (env,[]) bl in
+            let rbl = List.map (function BDRawDef a -> a | BDPattern _ -> assert false) rbl in
             (List.rev rbl,
              intern_type env' ty,env')) dl in
 	let idl = Array.map2 (fun (_,_,_,bd) (b,c,env') ->
 	     let env'' = List.fold_left_i (fun i en name ->
 					     let (bli,tyi,_) = idl_tmp.(i) in
 					     let cofix_args =  List.map (fun (_, (na, bk, _, _)) -> (build_impls bk na)) bli in
-	       push_name_env lvar (impls_type_list ~args:cofix_args tyi)
+	       push_name_env ntnvars (impls_type_list ~args:cofix_args tyi)
 					    en (Loc.ghost, Name name)) 0 env' lf in
              (b,c,intern {env'' with tmp_scope = None} bd)) dl idl_tmp in
 	GRec (loc,GCoFix n,
@@ -1449,15 +1617,15 @@ let internalize globalenv env allow_patvar lvar c =
     | CLetIn (loc,na,c1,c2) ->
 	let inc1 = intern (reset_tmp_scope env) c1 in
 	GLetIn (loc, snd na, inc1,
-          intern (push_name_env lvar (impls_term_list inc1) env na) c2)
+          intern (push_name_env ntnvars (impls_term_list inc1) env na) c2)
     | 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 lvar loc ntn args
+        intern_notation intern env ntnvars loc ntn args
     | CGeneralization (loc,b,a,c) ->
-        intern_generalization intern env lvar loc b a c
+        intern_generalization intern env ntnvars loc b a c
     | CPrim (loc, p) ->
 	fst (Notation.interp_prim_token loc p (env.tmp_scope,env.scopes))
     | CDelimiters (loc, key, e) ->
@@ -1485,7 +1653,7 @@ let internalize globalenv env allow_patvar lvar c =
 	       intern_applied_reference intern env
 		 (Environ.named_context globalenv) lvar us args ref
             | CNotation (loc,ntn,([],[],[])) ->
-                let c = intern_notation intern env lvar loc ntn ([],[],[]) in
+                let c = intern_notation intern env ntnvars loc ntn ([],[],[]) in
                 let x, impl, scopes, l = find_appl_head_data c in
 		  (x,impl,scopes,l), args
             | x -> (intern env f,[],[],[]), args in
@@ -1493,13 +1661,15 @@ let internalize globalenv env allow_patvar lvar c =
 	    (merge_impargs l args) loc
 
     | CRecord (loc, fs) ->
-	let cargs =
-	  sort_fields true loc fs
-	    (fun k l -> CHole (loc, Some (Evar_kinds.QuestionMark (Evar_kinds.Define true)), Misctypes.IntroAnonymous, None) :: l)
-	in
-	begin
-	  match cargs with
-	    | None -> user_err_loc (loc, "intern", str"No constructor inference.")
+       let st = Evar_kinds.Define (not (Program.get_proofs_transparency ())) in
+       let fields =
+	 sort_fields ~complete:true loc fs
+	             (fun _idx -> CHole (loc, Some (Evar_kinds.QuestionMark st),
+                                                 Misctypes.IntroAnonymous, None))
+       in
+       begin
+	  match fields with
+	    | None -> user_err ~loc ~hdr:"intern" (str"No constructor inference.")
 	    | Some (n, constrname, args) ->
 		let pars = List.make n (CHole (loc, None, Misctypes.IntroAnonymous, None)) in
                 let app = CAppExpl (loc, (None, constrname,None), List.rev_append pars args) in
@@ -1518,7 +1688,7 @@ let internalize globalenv env allow_patvar lvar c =
 	    (tm,ind)::inds, Option.fold_right Id.Set.add extra_id ex_ids, List.rev_append match_td matchs)
 	  tms ([],Id.Set.empty,[]) in
         let env' = Id.Set.fold
-	  (fun var bli -> push_name_env lvar (Variable,[],[],[]) bli (Loc.ghost,Name var))
+	  (fun var bli -> push_name_env ntnvars (Variable,[],[],[]) bli (Loc.ghost,Name var))
 	  (Id.Set.union ex_ids as_in_vars) (reset_hidden_inductive_implicit_test env) in
         (* PatVars before a real pattern do not need to be matched *)
         let stripped_match_from_in =
@@ -1552,22 +1722,26 @@ let internalize globalenv env allow_patvar lvar c =
 	(* "in" is None so no match to add *)
         let ((b',(na',_)),_,_) = intern_case_item env' Id.Set.empty (b,na,None) in
         let p' = Option.map (fun u ->
-	  let env'' = push_name_env lvar (Variable,[],[],[]) (reset_hidden_inductive_implicit_test env')
+	  let env'' = push_name_env ntnvars (Variable,[],[],[]) (reset_hidden_inductive_implicit_test env')
 	    (Loc.ghost,na') in
 	  intern_type env'' u) po in
         GLetTuple (loc, List.map snd nal, (na', p'), b',
-                   intern (List.fold_left (push_name_env lvar (Variable,[],[],[])) (reset_hidden_inductive_implicit_test env) nal) c)
+                   intern (List.fold_left (push_name_env ntnvars (Variable,[],[],[])) (reset_hidden_inductive_implicit_test env) nal) c)
     | CIf (loc, c, (na,po), b1, b2) ->
       let env' = reset_tmp_scope env in
       let ((c',(na',_)),_,_) = intern_case_item env' Id.Set.empty (c,na,None) in (* no "in" no match to ad too *)
       let p' = Option.map (fun p ->
-          let env'' = push_name_env lvar (Variable,[],[],[]) (reset_hidden_inductive_implicit_test env)
+          let env'' = push_name_env ntnvars (Variable,[],[],[]) (reset_hidden_inductive_implicit_test env)
 	    (Loc.ghost,na') in
 	  intern_type env'' p) po in
         GIf (loc, c', (na', p'), intern env b1, intern env b2)
     | CHole (loc, k, naming, solve) ->
         let k = match k with
-        | None -> Evar_kinds.QuestionMark (Evar_kinds.Define true)
+        | None ->
+           let st = Evar_kinds.Define (not (Program.get_proofs_transparency ())) in
+           (match naming with
+           | Misctypes.IntroIdentifier id -> Evar_kinds.NamedHole id
+           | _ -> Evar_kinds.QuestionMark st)
         | Some k -> k
         in
         let solve = match solve with
@@ -1606,7 +1780,7 @@ let internalize globalenv env allow_patvar lvar c =
   and intern_type env = intern (set_type_scope env)
 
   and intern_local_binder env bind =
-    intern_local_binder_aux intern lvar env bind
+    intern_local_binder_aux intern ntnvars env bind
 
   (* Expands a multiple pattern into a disjunction of multiple patterns *)
   and intern_multiple_pattern env n (loc,pl) =
@@ -1631,7 +1805,6 @@ let internalize globalenv env allow_patvar lvar c =
     let env_ids = List.fold_right Id.Set.add eqn_ids env.ids in
     List.map (fun (asubst,pl) ->
       let rhs = replace_vars_constr_expr asubst rhs in
-      Id.Map.iter message_redundant_alias asubst;
       let rhs' = intern {env with ids = env_ids} rhs in
       (loc,eqn_ids,pl,rhs')) pll
 
@@ -1685,11 +1858,11 @@ let internalize globalenv env allow_patvar lvar c =
     (tm',(snd na,typ)), extra_id, match_td
 
   and iterate_prod loc2 env bk ty body nal =
-    let env, bl = intern_assumption intern lvar env nal bk ty in
+    let env, bl = intern_assumption intern ntnvars env nal bk ty in
     it_mkGProd loc2 bl (intern_type env body)
 
   and iterate_lam loc2 env bk ty body nal =
-    let env, bl = intern_assumption intern lvar env nal bk ty in
+    let env, bl = intern_assumption intern ntnvars env nal bk ty in
     it_mkGLambda loc2 bl (intern env body)
 
   and intern_impargs c env l subscopes args =
@@ -1721,7 +1894,7 @@ let internalize globalenv env allow_patvar lvar c =
       | (imp::impl', []) ->
 	  if not (Id.Map.is_empty eargs) then
 	    (let (id,(loc,_)) = Id.Map.choose eargs in
-	       user_err_loc (loc,"",str "Not enough non implicit \
+	       user_err ~loc  (str "Not enough non implicit \
 	    arguments to accept the argument bound to " ++
 		 pr_id id ++ str"."));
 	  []
@@ -1731,7 +1904,7 @@ let internalize globalenv env allow_patvar lvar c =
     in aux 1 l subscopes eargs rargs
 
   and apply_impargs c env imp subscopes l loc = 
-    let imp = select_impargs_size (List.length l) imp in
+    let imp = select_impargs_size (List.length (List.filter (fun (_,x) -> x == None) l)) imp in
     let l = intern_impargs c env imp subscopes l in
       smart_gapp c loc l
 
@@ -1752,8 +1925,8 @@ let internalize globalenv env allow_patvar lvar c =
     intern env c
   with
       InternalizationError (loc,e) ->
-	user_err_loc (loc,"internalize",
-	  explain_internalization_error e)
+	user_err ~loc ~hdr:"internalize"
+	  (explain_internalization_error e)
 
 (**************************************************************************)
 (* Functions to translate constr_expr into glob_constr                    *)
@@ -1792,7 +1965,7 @@ let intern_pattern globalenv patt =
     intern_cases_pattern globalenv (None,[]) empty_alias patt
   with
       InternalizationError (loc,e) ->
-	user_err_loc (loc,"internalize",explain_internalization_error e)
+	user_err ~loc ~hdr:"internalize" (explain_internalization_error e)
 
 
 (*********************************************************************)
@@ -1865,14 +2038,14 @@ let interp_notation_constr ?(impls=empty_internalization_env) nenv a =
 						tmp_scope = None; scopes = []; impls = impls}
     false (empty_ltac_sign, vl) a in
   (* Translate and check that [c] has all its free variables bound in [vars] *)
-  let a = notation_constr_of_glob_constr nenv c in
+  let a, reversible = notation_constr_of_glob_constr nenv c in
   (* Splits variables into those that are binding, bound, or both *)
   (* binding and bound *)
   let out_scope = function None -> None,[] | Some (a,l) -> a,l in
   let vars = Id.Map.map (fun (isonlybinding, sc, typ) ->
     (!isonlybinding, out_scope !sc, typ)) vl in
   (* Returns [a] and the ordered list of variables with their scopes *)
-  vars, a
+  vars, a, reversible
 
 (* Interpret binders and contexts  *)
 
@@ -1895,22 +2068,33 @@ let intern_context global_level env impl_env binders =
   try
   let lvar = (empty_ltac_sign, Id.Map.empty) in
   let lenv, bl = List.fold_left
-	    (intern_local_binder_aux ~global_level (my_intern_constr env lvar) lvar)
+	    (fun (lenv, bl) b ->
+               let bl = List.map (fun a -> BDRawDef a) bl in
+	       let (env, bl) = intern_local_binder_aux ~global_level (my_intern_constr env lvar) Id.Map.empty (lenv, bl) b in
+               let bl =
+                 List.map
+                   (function
+                    | BDRawDef a -> a
+                    | BDPattern (loc,_,_,_,_) ->
+                        Loc.raise ~loc (Stream.Error "pattern with quote not allowed here")) bl in
+	       (env, bl))
 	    ({ids = extract_ids env; unb = false;
 	      tmp_scope = None; scopes = []; impls = impl_env}, []) binders in
   (lenv.impls, List.map snd bl)
   with InternalizationError (loc,e) ->
-    user_err_loc (loc,"internalize", explain_internalization_error e)
+    user_err ~loc ~hdr:"internalize" (explain_internalization_error e)
 
 let interp_rawcontext_evars env evdref k bl =
   let (env, par, _, impls) =
     List.fold_left
       (fun (env,params,n,impls) (na, k, b, t) ->
+       let t' =
+	 if Option.is_empty b then locate_if_hole (loc_of_glob_constr t) na t
+	 else t
+       in
+       let t = understand_tcc_evars env evdref ~expected_type:IsType t' in
 	match b with
 	    None ->
-	      let t' = locate_if_hole (loc_of_glob_constr t) na t in
-	      let t =
-                understand_tcc_evars env evdref ~expected_type:IsType t' in
 	      let d = LocalAssum (na,t) in
 	      let impls =
 		if k == Implicit then
@@ -1920,8 +2104,8 @@ let interp_rawcontext_evars env evdref k bl =
 	      in
 		(push_rel d env, d::params, succ n, impls)
 	  | Some b ->
-	      let c = understand_judgment_tcc env evdref b in
-	      let d = LocalDef (na, c.uj_val, c.uj_type) in
+	      let c = understand_tcc_evars env evdref ~expected_type:(OfType t) b in
+	      let d = LocalDef (na, c, t) in
 		(push_rel d env, d::params, n, impls))
       (env,[],k+1,[]) (List.rev bl)
   in (env, par), impls
diff --git a/interp/constrintern.mli b/interp/constrintern.mli
index eea76aa31..61e7c6f5c 100644
--- a/interp/constrintern.mli
+++ b/interp/constrintern.mli
@@ -186,7 +186,7 @@ val global_reference_in_absolute_module : DirPath.t -> Id.t -> constr
 val interp_notation_constr : ?impls:internalization_env ->
   notation_interp_env -> constr_expr ->
   (bool * subscopes * notation_var_internalization_type) Id.Map.t *
-  notation_constr
+  notation_constr * reversibility_flag
 
 (** Globalization options *)
 val parsing_explicit : bool ref
diff --git a/interp/coqlib.ml b/interp/coqlib.ml
index 23bcddaea..9539980f0 100644
--- a/interp/coqlib.ml
+++ b/interp/coqlib.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-open Errors
+open CErrors
 open Util
 open Pp
 open Names
@@ -86,7 +86,7 @@ let check_required_library d =
      (Loc.ghost,make_qualid (DirPath.make (List.rev prefix)) m)
 *)
 (* or failing ...*)
-      errorlabstrm "Coqlib.check_required_library"
+      user_err ~hdr:"Coqlib.check_required_library"
         (str "Library " ++ pr_dirpath dir ++ str " has to be required first.")
 
 (************************************************************************)
diff --git a/interp/dumpglob.ml b/interp/dumpglob.ml
index 931fc1ca4..b020f8945 100644
--- a/interp/dumpglob.ml
+++ b/interp/dumpglob.ml
@@ -45,10 +45,10 @@ let dump_string s =
   if dump () && !glob_output != Feedback then 
     Pervasives.output_string !glob_file s
 
-let start_dump_glob vfile =
+let start_dump_glob ~vfile ~vofile =
   match !glob_output with
   | MultFiles ->
-      open_glob_file (Filename.chop_extension vfile ^ ".glob");
+      open_glob_file (Filename.chop_extension vofile ^ ".glob");
       output_string !glob_file "DIGEST ";
       output_string !glob_file (Digest.to_hex (Digest.file vfile));
       output_char !glob_file '\n'
@@ -127,9 +127,10 @@ let type_of_global_ref gr =
     | Globnames.ConstructRef _ -> "constr"
 
 let remove_sections dir =
-  if Libnames.is_dirpath_prefix_of dir (Lib.cwd ()) then
+  let cwd = Lib.cwd_except_section () in
+  if Libnames.is_dirpath_prefix_of cwd dir then
     (* Not yet (fully) discharged *)
-    Libnames.pop_dirpath_n (Lib.sections_depth ()) (Lib.cwd ())
+    cwd
   else
     (* Theorem/Lemma outside its outer section of definition *)
     dir
diff --git a/interp/dumpglob.mli b/interp/dumpglob.mli
index a7c799114..e84a64052 100644
--- a/interp/dumpglob.mli
+++ b/interp/dumpglob.mli
@@ -9,7 +9,7 @@
 val open_glob_file : string -> unit
 val close_glob_file : unit -> unit
 
-val start_dump_glob : string -> unit
+val start_dump_glob : vfile:string -> vofile:string -> unit
 val end_dump_glob : unit -> unit
 
 val dump : unit -> bool
diff --git a/interp/genintern.ml b/interp/genintern.ml
index d6bfd347f..be7abfa99 100644
--- a/interp/genintern.ml
+++ b/interp/genintern.ml
@@ -16,6 +16,7 @@ type glob_sign = {
 
 type ('raw, 'glb) intern_fun = glob_sign -> 'raw -> glob_sign * 'glb
 type 'glb subst_fun = substitution -> 'glb -> 'glb
+type 'glb ntn_subst_fun = Tactypes.glob_constr_and_expr Id.Map.t -> 'glb -> 'glb
 
 module InternObj =
 struct
@@ -31,8 +32,16 @@ struct
   let default _ = None
 end
 
+module NtnSubstObj =
+struct
+  type ('raw, 'glb, 'top) obj = 'glb ntn_subst_fun
+  let name = "notation_subst"
+  let default _ = None
+end
+
 module Intern = Register (InternObj)
 module Subst = Register (SubstObj)
+module NtnSubst = Register (NtnSubstObj)
 
 let intern = Intern.obj
 let register_intern0 = Intern.register0
@@ -50,3 +59,12 @@ let generic_substitute subs (GenArg (Glbwit wit, v)) =
   in_gen (glbwit wit) (substitute wit subs v)
 
 let () = Hook.set Detyping.subst_genarg_hook generic_substitute
+
+(** Notation substitution *)
+
+let substitute_notation = NtnSubst.obj
+let register_ntn_subst0 = NtnSubst.register0
+
+let generic_substitute_notation env (GenArg (Glbwit wit, v)) =
+  let v = substitute_notation wit env v in
+  in_gen (glbwit wit) v
diff --git a/interp/genintern.mli b/interp/genintern.mli
index 4b244b38d..4b0354be3 100644
--- a/interp/genintern.mli
+++ b/interp/genintern.mli
@@ -32,6 +32,14 @@ val substitute : ('raw, 'glb, 'top) genarg_type -> 'glb subst_fun
 
 val generic_substitute : glob_generic_argument subst_fun
 
+(** {5 Notation functions} *)
+
+type 'glb ntn_subst_fun = Tactypes.glob_constr_and_expr Id.Map.t -> 'glb -> 'glb
+
+val substitute_notation : ('raw, 'glb, 'top) genarg_type -> 'glb ntn_subst_fun
+
+val generic_substitute_notation : glob_generic_argument ntn_subst_fun
+
 (** Registering functions *)
 
 val register_intern0 : ('raw, 'glb, 'top) genarg_type ->
@@ -39,3 +47,6 @@ val register_intern0 : ('raw, 'glb, 'top) genarg_type ->
 
 val register_subst0 : ('raw, 'glb, 'top) genarg_type ->
   'glb subst_fun -> unit
+
+val register_ntn_subst0 : ('raw, 'glb, 'top) genarg_type ->
+  'glb ntn_subst_fun -> unit
diff --git a/interp/implicit_quantifiers.ml b/interp/implicit_quantifiers.ml
index 567150a5d..77a8ed680 100644
--- a/interp/implicit_quantifiers.ml
+++ b/interp/implicit_quantifiers.ml
@@ -9,7 +9,7 @@
 (*i*)
 open Names
 open Decl_kinds
-open Errors
+open CErrors
 open Util
 open Glob_term
 open Constrexpr
@@ -21,18 +21,20 @@ open Libobject
 open Nameops
 open Misctypes
 open Context.Rel.Declaration
+
+module RelDecl = Context.Rel.Declaration
 (*i*)
 
 let generalizable_table = Summary.ref Id.Pred.empty ~name:"generalizable-ident"
 
 let declare_generalizable_ident table (loc,id) =
   if not (Id.equal id (root_of_id id)) then
-    user_err_loc(loc,"declare_generalizable_ident",
-    (pr_id id ++ str
+    user_err ~loc ~hdr:"declare_generalizable_ident"
+    ((pr_id id ++ str
       " is not declarable as generalizable identifier: it must have no trailing digits, quote, or _"));
   if Id.Pred.mem id table then
-    user_err_loc(loc,"declare_generalizable_ident",
-		(pr_id id++str" is already declared as a generalizable identifier"))
+    user_err ~loc ~hdr:"declare_generalizable_ident"
+		((pr_id id++str" is already declared as a generalizable identifier"))
   else Id.Pred.add id table
 
 let add_generalizable gen table =
@@ -78,8 +80,8 @@ let is_freevar ids env x =
 (* Auxiliary functions for the inference of implicitly quantified variables. *)
 
 let ungeneralizable loc id =
-  user_err_loc (loc, "Generalization", 
-	       str "Unbound and ungeneralizable variable " ++ pr_id id)
+  user_err ~loc ~hdr:"Generalization"
+	       (str "Unbound and ungeneralizable variable " ++ pr_id id)
 
 let free_vars_of_constr_expr c ?(bound=Id.Set.empty) l =
   let found loc id bdvars l =
@@ -112,6 +114,7 @@ let free_vars_of_binders ?(bound=Id.Set.empty) l (binders : local_binder list) =
 	let l' = free_vars_of_constr_expr c ~bound:bdvars l in
 	  aux (Id.Set.union (ids_of_list bound) bdvars) l' tl
 
+    | LocalPattern _ :: tl -> assert false
     | [] -> bdvars, l
   in aux bound l binders
 
@@ -185,7 +188,7 @@ let generalizable_vars_of_glob_constr ?(bound=Id.Set.empty) ?(allowed=Id.Set.emp
       vars
 
 let rec make_fresh ids env x =
-  if is_freevar ids env x then x else make_fresh ids env (Nameops.lift_subscript x)
+  if is_freevar ids env x then x else make_fresh ids env (Nameops.increment_subscript x)
 
 let next_name_away_from na avoid =
   match na with
@@ -197,12 +200,12 @@ let combine_params avoid fn applied needed =
     List.partition
       (function
 	  (t, Some (loc, ExplByName id)) ->
-            let is_id (_, decl) = match get_name decl with
+            let is_id (_, decl) = match RelDecl.get_name decl with
             | Name id' -> Id.equal id id'
             | Anonymous -> false
             in
 	    if not (List.exists is_id needed) then
-	      user_err_loc (loc,"",str "Wrong argument name: " ++ Nameops.pr_id id);
+	      user_err ~loc  (str "Wrong argument name: " ++ Nameops.pr_id id);
 	    true
 	| _ -> false) applied
   in
@@ -236,12 +239,12 @@ let combine_params avoid fn applied needed =
 	    aux (t' :: ids) avoid' app need
 
       | (x,_) :: _, [] ->
-	  user_err_loc (Constrexpr_ops.constr_loc x,"",str "Typeclass does not expect more arguments")
+	  user_err ~loc:(Constrexpr_ops.constr_loc x) (str "Typeclass does not expect more arguments")
   in aux [] avoid applied needed
 
 let combine_params_freevar =
   fun avoid (_, decl) ->
-    let id' = next_name_away_from (get_name decl) avoid in
+    let id' = next_name_away_from (RelDecl.get_name decl) avoid in
       (CRef (Ident (Loc.ghost, id'),None), Id.Set.add id' avoid)
 
 let destClassApp cl =
diff --git a/interp/interp.mllib b/interp/interp.mllib
index 96b52959a..607af82a0 100644
--- a/interp/interp.mllib
+++ b/interp/interp.mllib
@@ -1,5 +1,4 @@
 Stdarg
-Constrarg
 Genintern
 Constrexpr_ops
 Notation_ops
diff --git a/interp/modintern.ml b/interp/modintern.ml
index e5dce5ccf..d4ade7058 100644
--- a/interp/modintern.ml
+++ b/interp/modintern.ml
@@ -26,16 +26,16 @@ let error_not_a_module_loc kind loc qid =
     | ModType -> Modops.ModuleTypingError (Modops.NotAModuleType s)
     | ModAny -> ModuleInternalizationError (NotAModuleNorModtype s)
   in
-  Loc.raise loc e
+  Loc.raise ~loc e
 
 let error_application_to_not_path loc me =
-  Loc.raise loc (Modops.ModuleTypingError (Modops.ApplicationToNotPath me))
+  Loc.raise ~loc (Modops.ModuleTypingError (Modops.ApplicationToNotPath me))
 
 let error_incorrect_with_in_module loc =
-  Loc.raise loc (ModuleInternalizationError IncorrectWithInModule)
+  Loc.raise ~loc (ModuleInternalizationError IncorrectWithInModule)
 
 let error_application_to_module_type loc =
-  Loc.raise loc (ModuleInternalizationError IncorrectModuleApplication)
+  Loc.raise ~loc (ModuleInternalizationError IncorrectModuleApplication)
 
 (** Searching for a module name in the Nametab.
 
diff --git a/interp/notation.ml b/interp/notation.ml
index 3a078143b..66d3c9185 100644
--- a/interp/notation.ml
+++ b/interp/notation.ml
@@ -7,7 +7,7 @@
 (************************************************************************)
 
 (*i*)
-open Errors
+open CErrors
 open Util
 open Pp
 open Bigint
@@ -20,6 +20,9 @@ open Notation_term
 open Glob_term
 open Glob_ops
 open Ppextend
+open Context.Named.Declaration
+
+module NamedDecl = Context.Named.Declaration
 (*i*)
 
 (*s A scope is a set of notations; it includes
@@ -44,8 +47,14 @@ type level = precedence * tolerability list
 type delimiters = string
 type notation_location = (DirPath.t * DirPath.t) * string
 
+type notation_data = {
+  not_interp : interpretation;
+  not_location : notation_location;
+  not_onlyprinting : bool;
+}
+
 type scope = {
-  notations: (interpretation * notation_location) String.Map.t;
+  notations: notation_data String.Map.t;
   delimiters: delimiters option
 }
 
@@ -89,7 +98,7 @@ let declare_scope scope =
     scope_map := String.Map.add scope empty_scope !scope_map
 
 let error_unknown_scope sc =
-  errorlabstrm "Notation"
+  user_err ~hdr:"Notation"
     (str "Scope " ++ str sc ++ str " is not declared.")
 
 let find_scope scope =
@@ -184,7 +193,8 @@ let declare_delimiters scope key =
     | None -> scope_map := String.Map.add scope newsc !scope_map
     | Some oldkey when String.equal oldkey key -> ()
     | Some oldkey ->
-	Feedback.msg_warning
+        (** FIXME: implement multikey scopes? *)
+	Flags.if_verbose Feedback.msg_info
 	  (str "Overwriting previous delimiting key " ++ str oldkey ++ str " in scope " ++ str scope);
 	scope_map := String.Map.add scope newsc !scope_map
   end;
@@ -192,7 +202,7 @@ let declare_delimiters scope key =
     let oldscope = String.Map.find key !delimiters_map in
     if String.equal oldscope scope then ()
     else begin
-      Feedback.msg_warning (str "Hiding binding of key " ++ str key ++ str " to " ++ str oldscope);
+      Flags.if_verbose Feedback.msg_info (str "Hiding binding of key " ++ str key ++ str " to " ++ str oldscope);
       delimiters_map := String.Map.add key scope !delimiters_map
     end
   with Not_found -> delimiters_map := String.Map.add key scope !delimiters_map
@@ -201,7 +211,7 @@ let remove_delimiters scope =
   let sc = find_scope scope in
   let newsc = { sc with delimiters = None } in
   match sc.delimiters with
-    | None -> Feedback.msg_warning (str "No bound key for scope " ++ str scope ++ str ".")
+    | None -> CErrors.user_err  (str "No bound key for scope " ++ str scope ++ str ".")
     | Some key ->
        scope_map := String.Map.add scope newsc !scope_map;
        try
@@ -213,8 +223,8 @@ let remove_delimiters scope =
 let find_delimiters_scope loc key =
   try String.Map.find key !delimiters_map
   with Not_found ->
-    user_err_loc
-    (loc, "find_delimiters", str "Unknown scope delimiting key " ++ str key ++ str ".")
+    user_err ~loc ~hdr:"find_delimiters"
+      (str "Unknown scope delimiting key " ++ str key ++ str ".")
 
 (* Uninterpretation tables *)
 
@@ -330,8 +340,8 @@ let declare_string_interpreter sc dir interp (patl,uninterp,inpat) =
 let check_required_module loc sc (sp,d) =
   try let _ = Nametab.global_of_path sp in ()
   with Not_found ->
-    user_err_loc (loc,"prim_token_interpreter",
-    str "Cannot interpret in " ++ str sc ++ str " without requiring first module " ++ str (List.last d) ++ str ".")
+    user_err ~loc ~hdr:"prim_token_interpreter"
+    (str "Cannot interpret in " ++ str sc ++ str " without requiring first module " ++ str (List.last d) ++ str ".")
 
 (* Look if some notation or numeral printer in [scope] can be used in
    the scope stack [scopes], and if yes, using delimiters or not *)
@@ -380,17 +390,28 @@ let level_of_notation ntn =
 
 (* The mapping between notations and their interpretation *)
 
-let declare_notation_interpretation ntn scopt pat df =
+let warn_notation_overridden =
+  CWarnings.create ~name:"notation-overridden" ~category:"parsing"
+                   (fun (ntn,which_scope) ->
+                    str "Notation" ++ spc () ++ str ntn ++ spc ()
+                    ++ strbrk "was already used" ++ which_scope)
+
+let declare_notation_interpretation ntn scopt pat df ~onlyprint =
   let scope = match scopt with Some s -> s | None -> default_scope in
   let sc = find_scope scope in
   let () =
     if String.Map.mem ntn sc.notations then
     let which_scope = match scopt with
     | None -> mt ()
-    | Some _ -> str " in scope " ++ str scope in
-    Feedback.msg_warning (str "Notation " ++ str ntn ++ str " was already used" ++ which_scope)
+    | Some _ -> spc () ++ strbrk "in scope" ++ spc () ++ str scope in
+    warn_notation_overridden (ntn,which_scope)
   in
-  let sc = { sc with notations = String.Map.add ntn (pat,df) sc.notations } in
+  let notdata = {
+    not_interp = pat;
+    not_location = df;
+    not_onlyprinting = onlyprint;
+  } in
+  let sc = { sc with notations = String.Map.add ntn notdata sc.notations } in
   let () = scope_map := String.Map.add scope sc !scope_map in
   begin match scopt with
   | None -> scope_stack := SingleNotation ntn :: !scope_stack
@@ -415,7 +436,9 @@ let rec find_interpretation ntn find = function
       find_interpretation ntn find scopes
 
 let find_notation ntn sc =
-  String.Map.find ntn (find_scope sc).notations
+  let n = String.Map.find ntn (find_scope sc).notations in
+  let () = if n.not_onlyprinting then raise Not_found in
+  (n.not_interp, n.not_location)
 
 let notation_of_prim_token = function
   | Numeral n when is_pos_or_zero n -> to_string n
@@ -438,8 +461,8 @@ let interp_prim_token_gen g loc p local_scopes =
   let p_as_ntn = try notation_of_prim_token p with Not_found -> "" in
   try find_interpretation p_as_ntn (find_prim_token g loc p) scopes
   with Not_found ->
-    user_err_loc (loc,"interp_prim_token",
-    (match p with
+    user_err ~loc ~hdr:"interp_prim_token"
+    ((match p with
       | Numeral n -> str "No interpretation for numeral " ++ str (to_string n)
       | String s -> str "No interpretation for string " ++ qs s) ++ str ".")
 
@@ -463,8 +486,8 @@ let interp_notation loc ntn local_scopes =
   let scopes = make_current_scopes local_scopes in
   try find_interpretation ntn (find_notation ntn) scopes
   with Not_found ->
-    user_err_loc
-    (loc,"",str "Unknown interpretation for notation \"" ++ str ntn ++ str "\".")
+    user_err ~loc 
+    (str "Unknown interpretation for notation \"" ++ str ntn ++ str "\".")
 
 let uninterp_notations c =
   List.map_append (fun key -> keymap_find key !notations_key_table)
@@ -533,22 +556,20 @@ let ntpe_eq t1 t2 = match t1, t2 with
 | NtnTypeBinderList, NtnTypeBinderList -> true
 | (NtnTypeConstr | NtnTypeOnlyBinder | NtnTypeConstrList | NtnTypeBinderList), _ -> false
 
-
-let vars_eq (id1, (sc1, tp1)) (id2, (sc2, tp2)) =
-  Id.equal id1 id2 &&
+let var_attributes_eq (_, (sc1, tp1)) (_, (sc2, tp2)) =
   pair_eq (Option.equal String.equal) (List.equal String.equal) sc1 sc2 &&
   ntpe_eq tp1 tp2
 
 let interpretation_eq (vars1, t1) (vars2, t2) =
-  List.equal vars_eq vars1 vars2 &&
-  Notation_ops.eq_notation_constr t1 t2
+  List.equal var_attributes_eq vars1 vars2 &&
+  Notation_ops.eq_notation_constr (List.map fst vars1, List.map fst vars2) t1 t2
 
 let exists_notation_in_scope scopt ntn r =
   let scope = match scopt with Some s -> s | None -> default_scope in
   try
     let sc = String.Map.find scope !scope_map in
-    let (r',_) = String.Map.find ntn sc.notations in
-    interpretation_eq r' r
+    let n = String.Map.find ntn sc.notations in
+    interpretation_eq n.not_interp r
   with Not_found -> false
 
 let isNVar_or_NHole = function NVar _ | NHole _ -> true | _ -> false
@@ -638,7 +659,7 @@ type arguments_scope_discharge_request =
   | ArgsScopeManual
   | ArgsScopeNoDischarge
 
-let load_arguments_scope _ (_,(_,r,scl,cls)) =
+let load_arguments_scope _ (_,(_,r,n,scl,cls)) =
   List.iter (Option.iter check_scope) scl;
   let initial_stamp = ScopeClassMap.empty in
   arguments_scope := Refmap.add r (scl,cls,initial_stamp) !arguments_scope
@@ -649,7 +670,7 @@ let cache_arguments_scope o =
 let subst_scope_class subst cs =
   try Some (subst_cl_typ subst cs) with Not_found -> None
 
-let subst_arguments_scope (subst,(req,r,scl,cls)) =
+let subst_arguments_scope (subst,(req,r,n,scl,cls)) =
   let r' = fst (subst_global subst r) in
   let subst_cl ocl = match ocl with
     | None -> ocl
@@ -658,34 +679,42 @@ let subst_arguments_scope (subst,(req,r,scl,cls)) =
         | Some cl'  as ocl' when cl' != cl -> ocl'
         | _ -> ocl in
   let cls' = List.smartmap subst_cl cls in
-  (ArgsScopeNoDischarge,r',scl,cls')
+  (ArgsScopeNoDischarge,r',n,scl,cls')
 
-let discharge_arguments_scope (_,(req,r,l,_)) =
+let discharge_arguments_scope (_,(req,r,n,l,_)) =
   if req == ArgsScopeNoDischarge || (isVarRef r && Lib.is_in_section r) then None
-  else Some (req,Lib.discharge_global r,l,[])
+  else
+    let n =
+      try
+        let vars = Lib.variable_section_segment_of_reference r in
+        vars |> List.map fst |> List.filter is_local_assum |> List.length
+      with
+        Not_found (* Not a ref defined in this section *) -> 0 in
+    Some (req,Lib.discharge_global r,n,l,[])
 
-let classify_arguments_scope (req,_,_,_ as obj) =
+let classify_arguments_scope (req,_,_,_,_ as obj) =
   if req == ArgsScopeNoDischarge then Dispose else Substitute obj
 
-let rebuild_arguments_scope (req,r,l,_) =
+let rebuild_arguments_scope (req,r,n,l,_) =
   match req with
     | ArgsScopeNoDischarge -> assert false
     | ArgsScopeAuto ->
         let scs,cls = compute_arguments_scope_full (fst(Universes.type_of_global r)(*FIXME?*)) in
-	(req,r,scs,cls)
+	(req,r,List.length scs,scs,cls)
     | ArgsScopeManual ->
 	(* Add to the manually given scopes the one found automatically
            for the extra parameters of the section. Discard the classes
            of the manually given scopes to avoid further re-computations. *)
-	let l',cls = compute_arguments_scope_full (Global.type_of_global_unsafe r) in
-        let nparams = List.length l' - List.length l in
-	let l1 = List.firstn nparams l' in
-        let cls1 = List.firstn nparams cls in
-	(req,r,l1@l,cls1)
+        let l',cls = compute_arguments_scope_full (Global.type_of_global_unsafe r) in
+	let l1 = List.firstn n l' in
+        let cls1 = List.firstn n cls in
+	(req,r,0,l1@l,cls1)
 
 type arguments_scope_obj =
     arguments_scope_discharge_request * global_reference *
-      scope_name option list * scope_class option list
+    (* Used to communicate information from discharge to rebuild *)
+    (* set to 0 otherwise *) int *
+    scope_name option list * scope_class option list
 
 let inArgumentsScope : arguments_scope_obj -> obj =
   declare_object {(default_object "ARGUMENTS-SCOPE") with
@@ -698,16 +727,15 @@ let inArgumentsScope : arguments_scope_obj -> obj =
 
 let is_local local ref = local || isVarRef ref && Lib.is_in_section ref
 
-let declare_arguments_scope_gen req r (scl,cls) =
-  Lib.add_anonymous_leaf (inArgumentsScope (req,r,scl,cls))
+let declare_arguments_scope_gen req r n (scl,cls) =
+  Lib.add_anonymous_leaf (inArgumentsScope (req,r,n,scl,cls))
 
 let declare_arguments_scope local r scl =
-  let req = if is_local local r then ArgsScopeNoDischarge else ArgsScopeManual
-  in
-  (* We empty the list of argument classes to disable futher scope
+  let req = if is_local local r then ArgsScopeNoDischarge else ArgsScopeManual in
+  (* We empty the list of argument classes to disable further scope
      re-computations and keep these manually given scopes. *)
-  declare_arguments_scope_gen req r (scl,[])
-
+  declare_arguments_scope_gen req r 0 (scl,[])
+                              
 let find_arguments_scope r =
   try
     let (scl,cls,stamp) = Refmap.find r !arguments_scope in
@@ -722,7 +750,8 @@ let find_arguments_scope r =
 
 let declare_ref_arguments_scope ref =
   let t = Global.type_of_global_unsafe ref in
-  declare_arguments_scope_gen ArgsScopeAuto ref (compute_arguments_scope_full t)
+  let (scs,cls as o) = compute_arguments_scope_full t in
+  declare_arguments_scope_gen ArgsScopeAuto ref (List.length scs) o
 
 
 (********************************)
@@ -805,7 +834,7 @@ let pr_named_scope prglob scope sc =
   ++ fnl ()
   ++ pr_scope_classes scope
   ++ String.Map.fold
-       (fun ntn ((_,r),(_,df)) strm ->
+       (fun ntn { not_interp  = (_, r); not_location = (_, df) } strm ->
 	 pr_notation_info prglob df r ++ fnl () ++ strm)
        sc.notations (mt ())
 
@@ -849,7 +878,7 @@ let browse_notation strict ntn map =
   let l =
     String.Map.fold
       (fun scope_name sc ->
-	String.Map.fold (fun ntn ((_,r),df) l ->
+	String.Map.fold (fun ntn { not_interp  = (_, r); not_location = df } l ->
 	  if find ntn then (ntn,(scope_name,r,df))::l else l) sc.notations)
       map [] in
   List.sort (fun x y -> String.compare (fst x) (fst y)) l
@@ -862,11 +891,11 @@ let global_reference_of_notation test (ntn,(sc,c,_)) =
   | _ -> None
 
 let error_ambiguous_notation loc _ntn =
-  user_err_loc (loc,"",str "Ambiguous notation.")
+  user_err ~loc  (str "Ambiguous notation.")
 
 let error_notation_not_reference loc ntn =
-  user_err_loc (loc,"",
-    str "Unable to interpret " ++ quote (str ntn) ++
+  user_err ~loc 
+   (str "Unable to interpret " ++ quote (str ntn) ++
     str " as a reference.")
 
 let interp_notation_as_global_reference loc test ntn sc =
@@ -915,7 +944,7 @@ let locate_notation prglob ntn scope =
 let collect_notation_in_scope scope sc known =
   assert (not (String.equal scope default_scope));
   String.Map.fold
-    (fun ntn ((_,r),(_,df)) (l,known as acc) ->
+    (fun ntn { not_interp  = (_, r); not_location = (_, df) } (l,known as acc) ->
       if String.List.mem ntn known then acc else ((df,r)::l,ntn::known))
     sc.notations ([],known)
 
@@ -931,7 +960,7 @@ let collect_notations stack =
       | SingleNotation ntn ->
 	  if String.List.mem ntn knownntn then (all,knownntn)
 	  else
-	    let ((_,r),(_,df)) =
+	    let { not_interp  = (_, r); not_location = (_, df) } =
 	      String.Map.find ntn (find_scope default_scope).notations in
 	    let all' = match all with
 	      | (s,lonelyntn)::rest when String.equal s default_scope ->
@@ -967,33 +996,40 @@ let pr_visibility prglob = function
 type unparsing_rule = unparsing list * precedence
 type extra_unparsing_rules = (string * string) list
 (* Concrete syntax for symbolic-extension table *)
-let printing_rules =
-  ref (String.Map.empty : (unparsing_rule * extra_unparsing_rules) String.Map.t)
+let notation_rules =
+  ref (String.Map.empty : (unparsing_rule * extra_unparsing_rules * notation_grammar) String.Map.t)
 
-let declare_notation_printing_rule ntn ~extra unpl =
-  printing_rules := String.Map.add ntn (unpl,extra) !printing_rules
+let declare_notation_rule ntn ~extra unpl gram =
+  notation_rules := String.Map.add ntn (unpl,extra,gram) !notation_rules
 
 let find_notation_printing_rule ntn =
-  try fst (String.Map.find ntn !printing_rules)
+  try pi1 (String.Map.find ntn !notation_rules)
   with Not_found -> anomaly (str "No printing rule found for " ++ str ntn)
 let find_notation_extra_printing_rules ntn =
-  try snd (String.Map.find ntn !printing_rules)
+  try pi2 (String.Map.find ntn !notation_rules)
   with Not_found -> []
+let find_notation_parsing_rules ntn =
+  try pi3 (String.Map.find ntn !notation_rules)
+  with Not_found -> anomaly (str "No parsing rule found for " ++ str ntn)
+
+let get_defined_notations () =
+  String.Set.elements @@ String.Map.domain !notation_rules
+
 let add_notation_extra_printing_rule ntn k v =
   try
-    printing_rules := 
-      let p, pp = String.Map.find ntn !printing_rules in
-      String.Map.add ntn (p, (k,v) :: pp) !printing_rules
+    notation_rules :=
+      let p, pp, gr = String.Map.find ntn !notation_rules in
+      String.Map.add ntn (p, (k,v) :: pp, gr) !notation_rules
   with Not_found ->
-    user_err_loc (Loc.ghost,"add_notation_extra_printing_rule",
-      str "No such Notation.")
+    user_err ~hdr:"add_notation_extra_printing_rule"
+      (str "No such Notation.")
 
 (**********************************************************************)
 (* Synchronisation with reset *)
 
 let freeze _ =
  (!scope_map, !notation_level_map, !scope_stack, !arguments_scope,
-  !delimiters_map, !notations_key_table, !printing_rules,
+  !delimiters_map, !notations_key_table, !notation_rules,
   !scope_class_map)
 
 let unfreeze (scm,nlm,scs,asc,dlm,fkm,pprules,clsc) =
@@ -1003,7 +1039,7 @@ let unfreeze (scm,nlm,scs,asc,dlm,fkm,pprules,clsc) =
   delimiters_map := dlm;
   arguments_scope := asc;
   notations_key_table := fkm;
-  printing_rules := pprules;
+  notation_rules := pprules;
   scope_class_map := clsc
 
 let init () =
@@ -1011,7 +1047,7 @@ let init () =
   notation_level_map := String.Map.empty;
   delimiters_map := String.Map.empty;
   notations_key_table := KeyMap.empty;
-  printing_rules := String.Map.empty;
+  notation_rules := String.Map.empty;
   scope_class_map := initial_scope_class_map
 
 let _ =
@@ -1024,6 +1060,6 @@ let with_notation_protection f x =
   let fs = freeze false in
   try let a = f x in unfreeze fs; a
   with reraise ->
-    let reraise = Errors.push reraise in
+    let reraise = CErrors.push reraise in
     let () = unfreeze fs in
     iraise reraise
diff --git a/interp/notation.mli b/interp/notation.mli
index 480979ccc..2e92a00a8 100644
--- a/interp/notation.mli
+++ b/interp/notation.mli
@@ -109,7 +109,7 @@ type interp_rule =
   | SynDefRule of kernel_name
 
 val declare_notation_interpretation : notation -> scope_name option ->
-      interpretation -> notation_location -> unit
+      interpretation -> notation_location -> onlyprint:bool -> unit
 
 val declare_uninterpretation : interp_rule -> interpretation -> unit
 
@@ -196,12 +196,16 @@ val pr_visibility: (glob_constr -> std_ppcmds) -> scope_name option -> std_ppcmd
 (** Declare and look for the printing rule for symbolic notations *)
 type unparsing_rule = unparsing list * precedence
 type extra_unparsing_rules = (string * string) list
-val declare_notation_printing_rule :
-  notation -> extra:extra_unparsing_rules -> unparsing_rule -> unit
+val declare_notation_rule :
+  notation -> extra:extra_unparsing_rules -> unparsing_rule -> notation_grammar -> unit
 val find_notation_printing_rule : notation -> unparsing_rule
 val find_notation_extra_printing_rules : notation -> extra_unparsing_rules
+val find_notation_parsing_rules : notation -> notation_grammar
 val add_notation_extra_printing_rule : notation -> string -> string -> unit
 
+(** Returns notations with defined parsing/printing rules *)
+val get_defined_notations : unit -> notation list
+
 (** Rem: printing rules for primitive token are canonical *)
 
 val with_notation_protection : ('a -> 'b) -> 'a -> 'b
diff --git a/interp/notation_ops.ml b/interp/notation_ops.ml
index b4cf6e943..7dbd94aa7 100644
--- a/interp/notation_ops.ml
+++ b/interp/notation_ops.ml
@@ -7,7 +7,7 @@
 (************************************************************************)
 
 open Pp
-open Errors
+open CErrors
 open Util
 open Names
 open Nameops
@@ -47,62 +47,62 @@ let compare_glob_constr f add t1 t2 = match t1,t2 with
     | GHole _ | GSort _ | GLetIn _), _
       -> false
 
-let rec eq_notation_constr t1 t2 = match t1, t2 with
+let rec eq_notation_constr (vars1,vars2 as vars) t1 t2 = match t1, t2 with
 | NRef gr1, NRef gr2 -> eq_gr gr1 gr2
-| NVar id1, NVar id2 -> Id.equal id1 id2
+| NVar id1, NVar id2 -> Int.equal (List.index Id.equal id1 vars1) (List.index Id.equal id2 vars2)
 | NApp (t1, a1), NApp (t2, a2) ->
-  eq_notation_constr t1 t2 && List.equal eq_notation_constr a1 a2
+  (eq_notation_constr vars) t1 t2 && List.equal (eq_notation_constr vars) a1 a2
 | NHole (_, _, _), NHole (_, _, _) -> true (** FIXME? *)
 | NList (i1, j1, t1, u1, b1), NList (i2, j2, t2, u2, b2) ->
-  Id.equal i1 i2 && Id.equal j1 j2 && eq_notation_constr t1 t2 &&
-  eq_notation_constr u1 u2 && b1 == b2
+  Id.equal i1 i2 && Id.equal j1 j2 && (eq_notation_constr vars) t1 t2 &&
+  (eq_notation_constr vars) u1 u2 && b1 == b2
 | NLambda (na1, t1, u1), NLambda (na2, t2, u2) ->
-  Name.equal na1 na2 && eq_notation_constr t1 t2 && eq_notation_constr u1 u2
+  Name.equal na1 na2 && (eq_notation_constr vars) t1 t2 && (eq_notation_constr vars) u1 u2
 | NProd (na1, t1, u1), NProd (na2, t2, u2) ->
-  Name.equal na1 na2 && eq_notation_constr t1 t2 && eq_notation_constr u1 u2
+  Name.equal na1 na2 && (eq_notation_constr vars) t1 t2 && (eq_notation_constr vars) u1 u2
 | NBinderList (i1, j1, t1, u1), NBinderList (i2, j2, t2, u2) ->
-  Id.equal i1 i2 && Id.equal j1 j2 && eq_notation_constr t1 t2 &&
-  eq_notation_constr u1 u2
+  Id.equal i1 i2 && Id.equal j1 j2 && (eq_notation_constr vars) t1 t2 &&
+  (eq_notation_constr vars) u1 u2
 | NLetIn (na1, t1, u1), NLetIn (na2, t2, u2) ->
-  Name.equal na1 na2 && eq_notation_constr t1 t2 && eq_notation_constr u1 u2
+  Name.equal na1 na2 && (eq_notation_constr vars) t1 t2 && (eq_notation_constr vars) u1 u2
 | NCases (_, o1, r1, p1), NCases (_, o2, r2, p2) -> (** FIXME? *)
   let eqpat (p1, t1) (p2, t2) =
     List.equal cases_pattern_eq p1 p2 &&
-    eq_notation_constr t1 t2
+    (eq_notation_constr vars) t1 t2
   in
   let eqf (t1, (na1, o1)) (t2, (na2, o2)) =
     let eq (i1, n1) (i2, n2) = eq_ind i1 i2 && List.equal Name.equal n1 n2 in
-    eq_notation_constr t1 t2 && Name.equal na1 na2 && Option.equal eq o1 o2
+    (eq_notation_constr vars) t1 t2 && Name.equal na1 na2 && Option.equal eq o1 o2
   in
-  Option.equal eq_notation_constr o1 o2 &&
+  Option.equal (eq_notation_constr vars) o1 o2 &&
   List.equal eqf r1 r2 &&
   List.equal eqpat p1 p2
 | NLetTuple (nas1, (na1, o1), t1, u1), NLetTuple (nas2, (na2, o2), t2, u2) ->
   List.equal Name.equal nas1 nas2 &&
   Name.equal na1 na2 &&
-  Option.equal eq_notation_constr o1 o2 &&
-  eq_notation_constr t1 t2 &&
-  eq_notation_constr u1 u2
+  Option.equal (eq_notation_constr vars) o1 o2 &&
+  (eq_notation_constr vars) t1 t2 &&
+  (eq_notation_constr vars) u1 u2
 | NIf (t1, (na1, o1), u1, r1), NIf (t2, (na2, o2), u2, r2) ->
-  eq_notation_constr t1 t2 &&
+  (eq_notation_constr vars) t1 t2 &&
   Name.equal na1 na2 &&
-  Option.equal eq_notation_constr o1 o2 &&
-  eq_notation_constr u1 u2 &&
-  eq_notation_constr r1 r2
+  Option.equal (eq_notation_constr vars) o1 o2 &&
+  (eq_notation_constr vars) u1 u2 &&
+  (eq_notation_constr vars) r1 r2
 | NRec (_, ids1, ts1, us1, rs1), NRec (_, ids2, ts2, us2, rs2) -> (** FIXME? *)
   let eq (na1, o1, t1) (na2, o2, t2) =
     Name.equal na1 na2 &&
-    Option.equal eq_notation_constr o1 o2 &&
-    eq_notation_constr t1 t2
+    Option.equal (eq_notation_constr vars) o1 o2 &&
+    (eq_notation_constr vars) t1 t2
   in
   Array.equal Id.equal ids1 ids2 &&
   Array.equal (List.equal eq) ts1 ts2 &&
-  Array.equal eq_notation_constr us1 us2 &&
-  Array.equal eq_notation_constr rs1 rs2
+  Array.equal (eq_notation_constr vars) us1 us2 &&
+  Array.equal (eq_notation_constr vars) rs1 rs2
 | NSort s1, NSort s2 ->
   Miscops.glob_sort_eq s1 s2
 | NCast (t1, c1), NCast (t2, c2) ->
-  eq_notation_constr t1 t2 && cast_type_eq eq_notation_constr c1 c2
+  (eq_notation_constr vars) t1 t2 && cast_type_eq (eq_notation_constr vars) c1 c2
 | (NRef _ | NVar _ | NApp _ | NHole _ | NList _ | NLambda _ | NProd _
   | NBinderList _ | NLetIn _ | NCases _ | NLetTuple _ | NIf _
   | NRec _ | NSort _ | NCast _), _ -> false
@@ -111,7 +111,7 @@ let rec eq_notation_constr t1 t2 = match t1, t2 with
 (* Re-interpret a notation as a glob_constr, taking care of binders   *)
 
 let name_to_ident = function
-  | Anonymous -> Errors.error "This expression should be a simple identifier."
+  | Anonymous -> CErrors.error "This expression should be a simple identifier."
   | Name id -> id
 
 let to_id g e id = let e,na = g e (Name id) in e,name_to_ident na
@@ -124,6 +124,14 @@ let rec cases_pattern_fold_map loc g e = function
       let e',patl' = List.fold_map (cases_pattern_fold_map loc g) e patl in
       e', PatCstr (loc,cstr,patl',na')
 
+let subst_binder_type_vars l = function
+  | Evar_kinds.BinderType (Name id) ->
+     let id =
+       try match Id.List.assoc id l with GVar(_,id') -> id' | _ -> id
+       with Not_found -> id in
+     Evar_kinds.BinderType (Name id)
+  | e -> e
+
 let rec subst_glob_vars l = function
   | GVar (_,id) as r -> (try Id.List.assoc id l with Not_found -> r)
   | GProd (loc,Name id,bk,t,c) ->
@@ -136,6 +144,7 @@ let rec subst_glob_vars l = function
 	try match Id.List.assoc id l with GVar(_,id') -> id' | _ -> id
 	with Not_found -> id in
       GLambda (loc,Name id,bk,subst_glob_vars l t,subst_glob_vars l c)
+  | GHole (loc,x,naming,arg) -> GHole (loc,subst_binder_type_vars l x,naming,arg)
   | r -> map_glob_constr (subst_glob_vars l) r (* assume: id is not binding *)
 
 let ldots_var = Id.of_string ".."
@@ -233,11 +242,17 @@ let split_at_recursive_part c =
 let subtract_loc loc1 loc2 = Loc.make_loc (fst (Loc.unloc loc1),fst (Loc.unloc loc2)-1)
 
 let check_is_hole id = function GHole _ -> () | t ->
-  user_err_loc (loc_of_glob_constr t,"",
-    strbrk "In recursive notation with binders, " ++ pr_id id ++
+  user_err ~loc:(loc_of_glob_constr t)
+   (strbrk "In recursive notation with binders, " ++ pr_id id ++
     strbrk " is expected to come without type.")
 
-let compare_recursive_parts found f (iterator,subc) =
+let pair_equal eq1 eq2 (a,b) (a',b') = eq1 a a' && eq2 b b'
+
+type recursive_pattern_kind =
+| RecursiveTerms of bool (* associativity *)
+| RecursiveBinders of glob_constr * glob_constr
+
+let compare_recursive_parts found f f' (iterator,subc) =
   let diff = ref None in
   let terminator = ref None in
   let rec aux c1 c2 = match c1,c2 with
@@ -258,18 +273,16 @@ let compare_recursive_parts found f (iterator,subc) =
       let x,y = if lassoc then y,x else x,y in
       begin match !diff with
       | None ->
-        let () = diff := Some (x, y, Some lassoc) in
+        let () = diff := Some (x, y, RecursiveTerms lassoc) in
         true
       | Some _ -> false
       end
   | GLambda (_,Name x,_,t_x,c), GLambda (_,Name y,_,t_y,term)
   | GProd (_,Name x,_,t_x,c), GProd (_,Name y,_,t_y,term) ->
       (* We found a binding position where it differs *)
-      check_is_hole x t_x;
-      check_is_hole y t_y;
       begin match !diff with
       | None ->
-        let () = diff := Some (x, y, None) in
+        let () = diff := Some (x, y, RecursiveBinders (t_x,t_y)) in
         aux c term
       | Some _ -> false
       end
@@ -281,39 +294,52 @@ let compare_recursive_parts found f (iterator,subc) =
 	let loc1 = loc_of_glob_constr iterator in
 	let loc2 = loc_of_glob_constr (Option.get !terminator) in
 	(* Here, we would need a loc made of several parts ... *)
-	user_err_loc (subtract_loc loc1 loc2,"",
-          str "Both ends of the recursive pattern are the same.")
-    | Some (x,y,Some lassoc) ->
-	let newfound = (pi1 !found, (x,y) :: pi2 !found, pi3 !found) in
+	user_err ~loc:(subtract_loc loc1 loc2)
+          (str "Both ends of the recursive pattern are the same.")
+    | Some (x,y,RecursiveTerms lassoc) ->
+        let newfound,x,y,lassoc =
+          if List.mem_f (pair_equal Id.equal Id.equal) (x,y) (pi2 !found) ||
+             List.mem_f (pair_equal Id.equal Id.equal) (x,y) (pi3 !found)
+          then
+            !found,x,y,lassoc
+          else if List.mem_f (pair_equal Id.equal Id.equal) (y,x) (pi2 !found) ||
+                  List.mem_f (pair_equal Id.equal Id.equal) (y,x) (pi3 !found)
+          then
+            !found,y,x,not lassoc
+          else
+            (pi1 !found, (x,y) :: pi2 !found, pi3 !found),x,y,lassoc in
 	let iterator =
-	  f (if lassoc then subst_glob_vars [y,GVar(Loc.ghost,x)] iterator
-	  else iterator) in
+	  f' (if lassoc then iterator
+	      else subst_glob_vars [x,GVar(Loc.ghost,y)] iterator) in
 	(* found have been collected by compare_constr *)
 	found := newfound;
 	NList (x,y,iterator,f (Option.get !terminator),lassoc)
-    | Some (x,y,None) ->
+    | Some (x,y,RecursiveBinders (t_x,t_y)) ->
 	let newfound = (pi1 !found, pi2 !found, (x,y) :: pi3 !found) in
-	let iterator = f iterator in
+	let iterator = f' (subst_glob_vars [x,GVar(Loc.ghost,y)] iterator) in
 	(* found have been collected by compare_constr *)
 	found := newfound;
+	check_is_hole x t_x;
+	check_is_hole y t_y;
 	NBinderList (x,y,iterator,f (Option.get !terminator))
   else
     raise Not_found
 
 let notation_constr_and_vars_of_glob_constr a =
   let found = ref ([],[],[]) in
+  let has_ltac = ref false in
   let rec aux c =
     let keepfound = !found in
     (* n^2 complexity but small and done only once per notation *)
-    try compare_recursive_parts found aux' (split_at_recursive_part c)
+    try compare_recursive_parts found aux aux' (split_at_recursive_part c)
     with Not_found ->
     found := keepfound;
     match c with
     | GApp (_,GVar (loc,f),[c]) when Id.equal f ldots_var ->
 	(* Fall on the second part of the recursive pattern w/o having
 	   found the first part *)
-	user_err_loc (loc,"",
-	str "Cannot find where the recursive pattern starts.")
+	user_err ~loc 
+	(str "Cannot find where the recursive pattern starts.")
     | c ->
 	aux' c
   and aux' = function
@@ -347,7 +373,9 @@ let notation_constr_and_vars_of_glob_constr a =
       NRec (fk,idl,dll,Array.map aux tl,Array.map aux bl)
   | GCast (_,c,k) -> NCast (aux c,Miscops.map_cast_type aux k)
   | GSort (_,s) -> NSort s
-  | GHole (_,w,naming,arg) -> NHole (w, naming, arg)
+  | GHole (_,w,naming,arg) ->
+     if arg != None then has_ltac := true;
+     NHole (w, naming, arg)
   | GRef (_,r,_) -> NRef r
   | GEvar _ | GPatVar _ ->
       error "Existential variables not allowed in notations."
@@ -355,11 +383,10 @@ let notation_constr_and_vars_of_glob_constr a =
   in
   let t = aux a in
   (* Side effect *)
-  t, !found
-
-let pair_equal eq1 eq2 (a,b) (a',b') = eq1 a a' && eq2 b b'
+  t, !found, !has_ltac
 
-let check_variables nenv (found,foundrec,foundrecbinding) =
+let check_variables_and_reversibility nenv (found,foundrec,foundrecbinding) =
+  let injective = ref true in
   let recvars = nenv.ninterp_rec_vars in
   let fold _ y accu = Id.Set.add y accu in
   let useless_vars = Id.Map.fold fold recvars Id.Set.empty in
@@ -367,7 +394,7 @@ let check_variables nenv (found,foundrec,foundrecbinding) =
   let vars = Id.Map.filter filter nenv.ninterp_var_type in
   let check_recvar x =
     if Id.List.mem x found then
-      errorlabstrm "" (pr_id x ++
+      user_err  (pr_id x ++
 	strbrk " should only be used in the recursive part of a pattern.") in
   let check (x, y) = check_recvar x; check_recvar y in
   let () = List.iter check foundrec in
@@ -382,11 +409,11 @@ let check_variables nenv (found,foundrec,foundrecbinding) =
 	error
           (Id.to_string x ^
           " should not be bound in a recursive pattern of the right-hand side.")
-      else nenv.ninterp_only_parse <- true
+      else injective := false
   in
   let check_pair s x y where =
     if not (List.mem_f (pair_equal Id.equal Id.equal) (x,y) where) then
-      errorlabstrm "" (strbrk "in the right-hand side, " ++ pr_id x ++
+      user_err  (strbrk "in the right-hand side, " ++ pr_id x ++
 	str " and " ++ pr_id y ++ strbrk " should appear in " ++ str s ++
 	str " position as part of a recursive pattern.") in
   let check_type x typ =
@@ -402,12 +429,13 @@ let check_variables nenv (found,foundrec,foundrecbinding) =
 	  with Not_found -> check_bound x
 	end
     | NtnInternTypeIdent -> check_bound x in
-  Id.Map.iter check_type vars
+  Id.Map.iter check_type vars;
+  !injective
 
 let notation_constr_of_glob_constr nenv a =
-  let a, found = notation_constr_and_vars_of_glob_constr a in
-  let () = check_variables nenv found in
-  a
+  let a, found, has_ltac = notation_constr_and_vars_of_glob_constr a in
+  let injective = check_variables_and_reversibility nenv found in
+  a, not has_ltac && injective
 
 (**********************************************************************)
 (* Substitution of kernel names, avoiding a list of bound identifiers *)
@@ -417,7 +445,6 @@ let notation_constr_of_constr avoiding t =
   let nenv = {
     ninterp_var_type = Id.Map.empty;
     ninterp_rec_vars = Id.Map.empty;
-    ninterp_only_parse = false;
   } in
   notation_constr_of_glob_constr nenv t
 
@@ -435,7 +462,7 @@ let rec subst_notation_constr subst bound raw =
   | NRef ref ->
       let ref',t = subst_global subst ref in
 	if ref' == ref then raw else
-	  notation_constr_of_constr bound t
+	  fst (notation_constr_of_constr bound t)
 
   | NVar _ -> raw
 
@@ -585,6 +612,10 @@ let rec alpha_var id1 id2 = function
   | _::idl -> alpha_var id1 id2 idl
   | [] -> Id.equal id1 id2
 
+let alpha_rename alpmetas v =
+  if alpmetas == [] then v
+  else try rename_glob_vars alpmetas v with UnsoundRenaming -> raise No_match
+
 let add_env (alp,alpmetas) (terms,onlybinders,termlists,binderlists) var v =
   (* Check that no capture of binding variables occur *)
   (* [alp] is used when matching a pattern "fun x => ... x ... ?var ... x ..."
@@ -592,7 +623,8 @@ let add_env (alp,alpmetas) (terms,onlybinders,termlists,binderlists) var v =
      notation, as in "Notation "'twice_upto' y" := (fun x => x + x + y)". Then
      we keep (z,x) in alp, and we have to check that what the [v] which is bound
      to [var] does not contain z *)
-  if List.exists (fun (id,_) ->occur_glob_constr id v) alp then raise No_match;
+  if not (Id.equal ldots_var var) &&
+     List.exists (fun (id,_) -> occur_glob_constr id v) alp then raise No_match;
   (* [alpmetas] is used when matching a pattern "fun x => ... x ... ?var ... x ..."
      with an actual term "fun z => ... z ..." when "x" is bound in the
      notation and the name "x" cannot be changed to "z", e.g. because
@@ -610,16 +642,29 @@ let add_env (alp,alpmetas) (terms,onlybinders,termlists,binderlists) var v =
      glob_constr_eq in bind_term_env to be postponed in match_notation_constr, and the
      choice of exact variable be done there; but again, this would be a non-trivial
      refinement *)
-  if alpmetas != [] then raise No_match;
+  let v = alpha_rename alpmetas v in
   (* TODO: handle the case of multiple occs in different scopes *)
   ((var,v)::terms,onlybinders,termlists,binderlists)
 
+let add_termlist_env (alp,alpmetas) (terms,onlybinders,termlists,binderlists) var vl =
+  if List.exists (fun (id,_) -> List.exists (occur_glob_constr id) vl) alp then raise No_match;
+  let vl = List.map (alpha_rename alpmetas) vl in
+  (terms,onlybinders,(var,vl)::termlists,binderlists)
+
 let add_binding_env alp (terms,onlybinders,termlists,binderlists) var v =
   (* TODO: handle the case of multiple occs in different scopes *)
   (terms,(var,v)::onlybinders,termlists,binderlists)
 
 let add_bindinglist_env (terms,onlybinders,termlists,binderlists) x bl =
-  (terms,onlybinders,termlists,(x,List.rev bl)::binderlists)
+  (terms,onlybinders,termlists,(x,bl)::binderlists)
+
+let rec pat_binder_of_term = function
+  | GVar (loc, id) -> PatVar (loc, Name id)
+  | GApp (loc, GRef (_,ConstructRef cstr,_), l) ->
+     let nparams = Inductiveops.inductive_nparams (fst cstr) in
+     let _,l = List.chop nparams l in
+     PatCstr (loc, cstr, List.map pat_binder_of_term l, Anonymous)
+  | _ -> raise No_match
 
 let bind_term_env alp (terms,onlybinders,termlists,binderlists as sigma) var v =
   try
@@ -630,10 +675,53 @@ let bind_term_env alp (terms,onlybinders,termlists,binderlists as sigma) var v =
         let sigma = Id.List.remove_assoc var terms,onlybinders,termlists,binderlists in
         add_env alp sigma var v
     | _, _ ->
-        if glob_constr_eq v v' then sigma
+        if glob_constr_eq (alpha_rename (snd alp) v) v' then sigma
         else raise No_match
   with Not_found -> add_env alp sigma var v
 
+let bind_termlist_env alp (terms,onlybinders,termlists,binderlists as sigma) var vl =
+  try
+    let vl' = Id.List.assoc var termlists in
+    let unify_term v v' =
+      match v, v' with
+      | GHole _, _ -> v'
+      | _, GHole _ -> v
+      | _, _ -> if glob_constr_eq (alpha_rename (snd alp) v) v' then v' else raise No_match in
+    let rec unify vl vl' =
+      match vl, vl' with
+      | [], [] -> []
+      | v :: vl, v' :: vl' -> unify_term v v' :: unify vl vl'
+      | _ -> raise No_match in
+    let vl = unify vl vl' in
+    let sigma = (terms,onlybinders,Id.List.remove_assoc var termlists,binderlists) in
+    add_termlist_env alp sigma var vl
+  with Not_found -> add_termlist_env alp sigma var vl
+
+let bind_term_as_binding_env alp (terms,onlybinders,termlists,binderlists as sigma) var id =
+  try
+    match Id.List.assoc var terms with
+    | GVar (_,id') ->
+       (if not (Id.equal id id') then (fst alp,(id,id')::snd alp) else alp),
+       sigma
+    | _ -> anomaly (str "A term which can be a binder has to be a variable")
+  with Not_found ->
+    (* The matching against a term allowing to find the instance has not been found yet *)
+    (* If it will be a different name, we shall unfortunately fail *)
+    (* TODO: look at the consequences for alp *)
+    alp, add_env alp sigma var (GVar (Loc.ghost,id))
+
+let bind_binding_as_term_env alp (terms,onlybinders,termlists,binderlists as sigma) var id =
+  try
+    let v' = Id.List.assoc var onlybinders in
+    match v' with
+    | Anonymous ->
+        (* Should not occur, since the term has to be bound upwards *)
+        let sigma = (terms,Id.List.remove_assoc var onlybinders,termlists,binderlists) in
+        add_binding_env alp sigma var (Name id)
+    | Name id' ->
+        if Id.equal (rename_var (snd alp) id) id' then sigma else raise No_match
+  with Not_found -> add_binding_env alp sigma var (Name id)
+
 let bind_binding_env alp (terms,onlybinders,termlists,binderlists as sigma) var v =
   try
     let v' = Id.List.assoc var onlybinders in
@@ -647,6 +735,109 @@ let bind_binding_env alp (terms,onlybinders,termlists,binderlists as sigma) var
         else (fst alp,(id1,id2)::snd alp),sigma
   with Not_found -> alp, add_binding_env alp sigma var v
 
+let rec map_cases_pattern_name_left f = function
+  | PatVar (loc,na) -> PatVar (loc,f na)
+  | PatCstr (loc,c,l,na) -> PatCstr (loc,c,List.map_left (map_cases_pattern_name_left f) l,f na)
+
+let rec fold_cases_pattern_eq f x p p' = match p, p' with
+  | PatVar (loc,na), PatVar (_,na') -> let x,na = f x na na' in x, PatVar (loc,na)
+  | PatCstr (loc,c,l,na), PatCstr (_,c',l',na') when eq_constructor c c' ->
+     let x,l = fold_cases_pattern_list_eq f x l l' in
+     let x,na = f x na na' in
+     x, PatCstr (loc,c,l,na)
+  | _ -> failwith "Not equal"
+
+and fold_cases_pattern_list_eq f x pl pl' = match pl, pl' with
+  | [], [] -> x, []
+  | p::pl, p'::pl' ->
+     let x, p = fold_cases_pattern_eq f x p p' in
+     let x, pl = fold_cases_pattern_list_eq f x pl pl' in
+     x, p :: pl
+  | _ -> assert false
+
+let rec cases_pattern_eq p1 p2 = match p1, p2 with
+| PatVar (_, na1), PatVar (_, na2) -> Name.equal na1 na2
+| PatCstr (_, c1, pl1, na1), PatCstr (_, c2, pl2, na2) ->
+  eq_constructor c1 c2 && List.equal cases_pattern_eq pl1 pl2 &&
+  Name.equal na1 na2
+| _ -> false
+
+let bind_bindinglist_env alp (terms,onlybinders,termlists,binderlists as sigma) var bl =
+  let bl = List.rev bl in
+  try
+    let bl' = Id.List.assoc var binderlists in
+    let unify_name alp na na' =
+      match na, na' with
+      | Anonymous, na' -> alp, na'
+      | na, Anonymous -> alp, na
+      | Name id, Name id' ->
+         if Id.equal id id' then alp, na'
+         else (fst alp,(id,id')::snd alp), na' in
+    let unify_pat alp p p' =
+      try fold_cases_pattern_eq unify_name alp p p' with Failure _ -> raise No_match in
+    let unify_term alp v v' =
+      match v, v' with
+      | GHole _, _ -> v'
+      | _, GHole _ -> v
+      | _, _ -> if glob_constr_eq (alpha_rename (snd alp) v) v' then v else raise No_match in
+    let unify_binding_kind bk bk' = if bk == bk' then bk' else raise No_match in
+    let unify_binder alp b b' =
+      match b, b' with
+      | (Inl na, bk, None, t), (Inl na', bk', None, t') (* assum *) ->
+         let alp, na = unify_name alp na na' in
+         alp, (Inl na, unify_binding_kind bk bk', None, unify_term alp t t')
+      | (Inl na, bk, Some c, t), (Inl na', bk', Some c', t') (* let *) ->
+         let alp, na = unify_name alp na na' in
+         alp, (Inl na, unify_binding_kind bk bk', Some (unify_term alp c c'), unify_term alp t t')
+      | (Inr p, bk, None, t), (Inr p', bk', None, t') (* pattern *) ->
+         let alp, p = unify_pat alp p p' in
+         alp, (Inr p, unify_binding_kind bk bk', None, unify_term alp t t')
+      | _ -> raise No_match in
+    let rec unify alp bl bl' =
+    match bl, bl' with
+    | [], [] -> alp, []
+    | b :: bl, b' :: bl' ->
+       let alp,b = unify_binder alp b b' in
+       let alp,bl = unify alp bl bl' in
+       alp, b :: bl
+    | _ -> raise No_match in
+    let alp, bl = unify alp bl bl' in
+    let sigma = (terms,Id.List.remove_assoc var onlybinders,termlists,binderlists) in
+    alp, add_bindinglist_env sigma var bl
+  with Not_found ->
+    alp, add_bindinglist_env sigma var bl
+
+let bind_bindinglist_as_term_env alp (terms,onlybinders,termlists,binderlists) var cl =
+  try
+    let bl' = Id.List.assoc var binderlists in
+    let unify_id id na' =
+      match na' with
+      | Anonymous -> Name (rename_var (snd alp) id)
+      | Name id' ->
+         if Id.equal (rename_var (snd alp) id) id' then na' else raise No_match in
+    let unify_pat p p' =
+      if cases_pattern_eq (map_cases_pattern_name_left (name_app (rename_var (snd alp))) p) p' then p'
+      else raise No_match in
+    let unify_term_binder c b' =
+      match c, b' with
+      | GVar (_, id), (Inl na', bk', None, t') (* assum *) ->
+         (Inl (unify_id id na'), bk', None, t')
+      | c, (Inr p', bk', None, t') (* pattern *) ->
+         let p = pat_binder_of_term c in
+         (Inr (unify_pat p p'), bk', None, t')
+      | _ -> raise No_match in
+    let rec unify cl bl' =
+    match cl, bl' with
+    | [], [] -> []
+    | c :: cl, (Inl _, _, Some _,t) :: bl' -> unify cl bl'
+    | c :: cl, b' :: bl' -> unify_term_binder c b' :: unify cl bl'
+    | _ -> raise No_match in
+    let bl = unify cl bl' in
+    let sigma = (terms,onlybinders,termlists,Id.List.remove_assoc var binderlists) in
+    add_bindinglist_env sigma var bl
+  with Not_found ->
+    anomaly (str "There should be a binder list bindings this list of terms")
+
 let match_fix_kind fk1 fk2 =
   match (fk1,fk2) with
   | GCoFix n1, GCoFix n2 -> Int.equal n1 n2
@@ -670,8 +861,8 @@ let match_names metas (alp,sigma) na1 na2 = match (na1,na2) with
       bind_binding_env alp sigma id2 na1
   | (Name id1,Name id2) when is_term_meta id2 metas ->
       (* We let the non-binding occurrence define the rhs and hence reason up to *)
-      (* alpha-conversion for the given occurrence of the name (see #)) *)
-      (fst alp,(id1,id2)::snd alp), sigma
+      (* alpha-conversion for the given occurrence of the name (see #4592)) *)
+      bind_term_as_binding_env alp sigma id2 id1
   | (Anonymous,Name id2) when is_term_meta id2 metas ->
       (* We let the non-binding occurrence define the rhs *)
       alp, sigma
@@ -691,47 +882,69 @@ let rec match_cases_pattern_binders metas acc pat1 pat2 =
 let glue_letin_with_decls = true
 
 let rec match_iterated_binders islambda decls = function
+  | GLambda (_,Name p,bk,t,GCases (_,LetPatternStyle,None,[(GVar(_,e),_)],[(_,_,[cp],b)]))
+      when islambda && Id.equal p e ->
+      match_iterated_binders islambda ((Inr cp,bk,None,t)::decls) b
   | GLambda (_,na,bk,t,b) when islambda ->
-      match_iterated_binders islambda ((na,bk,None,t)::decls) b
+      match_iterated_binders islambda ((Inl na,bk,None,t)::decls) b
+  | GProd (_,Name p,bk,t,GCases (_,LetPatternStyle,None,[(GVar(_,e),_)],[(_,_,[cp],b)]))
+      when not islambda && Id.equal p e ->
+      match_iterated_binders islambda ((Inr cp,bk,None,t)::decls) b
   | GProd (_,(Name _ as na),bk,t,b) when not islambda ->
-      match_iterated_binders islambda ((na,bk,None,t)::decls) b
+      match_iterated_binders islambda ((Inl na,bk,None,t)::decls) b
   | GLetIn (loc,na,c,b) when glue_letin_with_decls ->
       match_iterated_binders islambda
-	((na,Explicit (*?*), Some c,GHole(loc,Evar_kinds.BinderType na,Misctypes.IntroAnonymous,None))::decls) b
+	((Inl na,Explicit (*?*), Some c,GHole(loc,Evar_kinds.BinderType na,Misctypes.IntroAnonymous,None))::decls) b
   | b -> (decls,b)
 
 let remove_sigma x (terms,onlybinders,termlists,binderlists) =
   (Id.List.remove_assoc x terms,onlybinders,termlists,binderlists)
 
+let remove_bindinglist_sigma x (terms,onlybinders,termlists,binderlists) =
+  (terms,onlybinders,termlists,Id.List.remove_assoc x binderlists)
+
 let add_ldots_var metas = (ldots_var,((None,[]),NtnTypeConstr))::metas
 
-let match_abinderlist_with_app match_fun metas sigma rest x iter termin =
-  let rec aux sigma acc rest =
+let add_meta_bindinglist x metas = (x,((None,[]),NtnTypeBinderList))::metas
+
+let match_binderlist_with_app match_fun alp metas sigma rest x y iter termin =
+  let rec aux sigma bl rest =
     try
-      let (terms,_,_,binderlists as sigma) = match_fun (add_ldots_var metas) sigma rest iter in
+      let metas = add_ldots_var (add_meta_bindinglist y metas) in
+      let (terms,_,_,binderlists as sigma) = match_fun alp metas sigma rest iter in
       let rest = Id.List.assoc ldots_var terms in
       let b =
-        match Id.List.assoc x binderlists with [b] -> b | _ ->assert false
+        match Id.List.assoc y binderlists with [b] -> b | _ ->assert false
       in
-      let sigma = remove_sigma x (remove_sigma ldots_var sigma) in
-      aux sigma (b::acc) rest
-    with No_match when not (List.is_empty acc) ->
-      acc, match_fun metas sigma rest termin in
-  let bl,sigma = aux sigma [] rest in
-  add_bindinglist_env sigma x bl
+      let sigma = remove_bindinglist_sigma y (remove_sigma ldots_var sigma) in
+      aux sigma (b::bl) rest
+    with No_match when not (List.is_empty bl) ->
+      bl, rest, sigma in
+  let bl,rest,sigma = aux sigma [] rest in
+  let alp,sigma = bind_bindinglist_env alp sigma x bl in
+  match_fun alp metas sigma rest termin
+
+let add_meta_term x metas = (x,((None,[]),NtnTypeConstr))::metas
 
-let match_alist match_fun metas sigma rest x iter termin lassoc =
+let match_termlist match_fun alp metas sigma rest x y iter termin lassoc =
   let rec aux sigma acc rest =
     try
-      let (terms,_,_,_ as sigma) = match_fun (add_ldots_var metas) sigma rest iter in
+      let metas = add_ldots_var (add_meta_term y metas) in
+      let (terms,_,_,_ as sigma) = match_fun metas sigma rest iter in
       let rest = Id.List.assoc ldots_var terms in
-      let t = Id.List.assoc x terms in
-      let sigma = remove_sigma x (remove_sigma ldots_var sigma) in
+      let t = Id.List.assoc y terms in
+      let sigma = remove_sigma y (remove_sigma ldots_var sigma) in
       aux sigma (t::acc) rest
     with No_match when not (List.is_empty acc) ->
       acc, match_fun metas sigma rest termin in
   let l,(terms,onlybinders,termlists,binderlists as sigma) = aux sigma [] rest in
-  (terms,onlybinders,(x,if lassoc then l else List.rev l)::termlists, binderlists)
+  let l = if lassoc then l else List.rev l in
+  if is_bindinglist_meta x metas then
+    (* This is a recursive pattern for both bindings and terms; it is *)
+    (* registered for binders *)
+    bind_bindinglist_as_term_env alp sigma x l
+  else
+    bind_termlist_env alp sigma x l
 
 let does_not_come_from_already_eta_expanded_var =
   (* This is hack to avoid looping on a rule with rhs of the form *)
@@ -750,32 +963,58 @@ let rec match_ inner u alp metas sigma a1 a2 =
 
   (* Matching notation variable *)
   | r1, NVar id2 when is_term_meta id2 metas -> bind_term_env alp sigma id2 r1
+  | GVar (_,id1), NVar id2 when is_onlybinding_meta id2 metas -> bind_binding_as_term_env alp sigma id2 id1
+  | r1, NVar id2 when is_bindinglist_meta id2 metas -> bind_term_env alp sigma id2 r1
 
   (* Matching recursive notations for terms *)
-  | r1, NList (x,_,iter,termin,lassoc) ->
-      match_alist (match_hd u alp) metas sigma r1 x iter termin lassoc
+  | r1, NList (x,y,iter,termin,lassoc) ->
+      match_termlist (match_hd u alp) alp metas sigma r1 x y iter termin lassoc
+
+  (* "λ p, let 'cp = p in t" -> "λ 'cp, t" *)
+  | GLambda (_,Name p,bk,t1,GCases (_,LetPatternStyle,None,[(GVar(_,e),_)],[(_,_,[cp],b1)])),
+    NBinderList (x,_,NLambda (Name _id2,_,b2),termin) when Id.equal p e ->
+      let (decls,b) = match_iterated_binders true [(Inr cp,bk,None,t1)] b1 in
+      let alp,sigma = bind_bindinglist_env alp sigma x decls in
+      match_in u alp metas sigma b termin
 
   (* Matching recursive notations for binders: ad hoc cases supporting let-in *)
-  | GLambda (_,na1,bk,t1,b1), NBinderList (x,_,NLambda (Name id2,_,b2),termin)->
-      let (decls,b) = match_iterated_binders true [(na1,bk,None,t1)] b1 in
+  | GLambda (_,na1,bk,t1,b1), NBinderList (x,_,NLambda (Name _id2,_,b2),termin)->
+      let (decls,b) = match_iterated_binders true [(Inl na1,bk,None,t1)] b1 in
       (* TODO: address the possibility that termin is a Lambda itself *)
-      match_in u alp metas (add_bindinglist_env sigma x decls) b termin
-  | GProd (_,na1,bk,t1,b1), NBinderList (x,_,NProd (Name id2,_,b2),termin)
+      let alp,sigma = bind_bindinglist_env alp sigma x decls in
+      match_in u alp metas sigma b termin
+
+  (* "∀ p, let 'cp = p in t" -> "∀ 'cp, t" *)
+  | GProd (_,Name p,bk,t1,GCases (_,LetPatternStyle,None,[(GVar(_,e),_)],[(_,_,[cp],b1)])),
+    NBinderList (x,_,NProd (Name _id2,_,b2),(NVar v as termin)) when Id.equal p e ->
+      let (decls,b) = match_iterated_binders true [(Inr cp,bk,None,t1)] b1 in
+      let alp,sigma = bind_bindinglist_env alp sigma x decls in
+      match_in u alp metas sigma b termin
+
+  | GProd (_,na1,bk,t1,b1), NBinderList (x,_,NProd (Name _id2,_,b2),termin)
       when na1 != Anonymous ->
-      let (decls,b) = match_iterated_binders false [(na1,bk,None,t1)] b1 in
+      let (decls,b) = match_iterated_binders false [(Inl na1,bk,None,t1)] b1 in
       (* TODO: address the possibility that termin is a Prod itself *)
-      match_in u alp metas (add_bindinglist_env sigma x decls) b termin
+      let alp,sigma = bind_bindinglist_env alp sigma x decls in
+      match_in u alp metas sigma b termin
   (* Matching recursive notations for binders: general case *)
-  | r, NBinderList (x,_,iter,termin) ->
-      match_abinderlist_with_app (match_hd u alp) metas sigma r x iter termin
+  | r, NBinderList (x,y,iter,termin) ->
+      match_binderlist_with_app (match_hd u) alp metas sigma r x y iter termin
 
   (* Matching individual binders as part of a recursive pattern *)
+  | GLambda (_,Name p,bk,t,GCases (_,LetPatternStyle,None,[(GVar(_,e),_)],[(_,_,[cp],b1)])),
+    NLambda (Name id,_,b2)
+      when is_bindinglist_meta id metas ->
+      let alp,sigma = bind_bindinglist_env alp sigma id [(Inr cp,bk,None,t)] in
+      match_in u alp metas sigma b1 b2
   | GLambda (_,na,bk,t,b1), NLambda (Name id,_,b2)
       when is_bindinglist_meta id metas ->
-      match_in u alp metas (add_bindinglist_env sigma id [(na,bk,None,t)]) b1 b2
+      let alp,sigma = bind_bindinglist_env alp sigma id [(Inl na,bk,None,t)] in
+      match_in u alp metas sigma b1 b2
   | GProd (_,na,bk,t,b1), NProd (Name id,_,b2)
       when is_bindinglist_meta id metas && na != Anonymous ->
-      match_in u alp metas (add_bindinglist_env sigma id [(na,bk,None,t)]) b1 b2
+      let alp,sigma = bind_bindinglist_env alp sigma id [(Inl na,bk,None,t)] in
+      match_in u alp metas sigma b1 b2
 
   (* Matching compositionally *)
   | GVar (_,id1), NVar id2 when alpha_var id1 id2 (fst alp) -> sigma
@@ -862,7 +1101,7 @@ let rec match_ inner u alp metas sigma a1 a2 =
       | _ -> assert false in
       let (alp,sigma) =
         if is_bindinglist_meta id metas then
-          alp, add_bindinglist_env sigma id [(Name id',Explicit,None,t1)]
+          bind_bindinglist_env alp sigma id [(Inl (Name id'),Explicit,None,t1)]
         else
           match_names metas (alp,sigma) (Name id') na in
       match_in u alp metas sigma (mkGApp Loc.ghost b1 (GVar (Loc.ghost,id'))) b2
@@ -890,6 +1129,10 @@ let term_of_binder = function
   | Name id -> GVar (Loc.ghost,id)
   | Anonymous -> GHole (Loc.ghost,Evar_kinds.InternalHole,Misctypes.IntroAnonymous,None)
 
+type glob_decl2 =
+    (name, cases_pattern) Util.union * Decl_kinds.binding_kind *
+      glob_constr option * glob_constr
+
 let match_notation_constr u c (metas,pat) =
   let terms,binders,termlists,binderlists =
     match_ false u ([],[]) metas ([],[],[],[]) c pat in
@@ -903,13 +1146,15 @@ let match_notation_constr u c (metas,pat) =
   List.fold_right (fun (x,(scl,typ)) (terms',termlists',binders') ->
     match typ with
     | NtnTypeConstr ->
-       ((Id.List.assoc x terms, scl)::terms',termlists',binders')
+      let term = try Id.List.assoc x terms with Not_found -> raise No_match in
+       ((term, scl)::terms',termlists',binders')
     | NtnTypeOnlyBinder ->
        ((find_binder x, scl)::terms',termlists',binders')
     | NtnTypeConstrList ->
        (terms',(Id.List.assoc x termlists,scl)::termlists',binders')
     | NtnTypeBinderList ->
-       (terms',termlists',(Id.List.assoc x binderlists,scl)::binders'))
+      let bl = try Id.List.assoc x binderlists with Not_found -> raise No_match in
+       (terms',termlists',(bl, scl)::binders'))
     metas ([],[],[])
 
 (* Matching cases pattern *)
@@ -926,7 +1171,21 @@ let bind_env_cases_pattern (terms,x,termlists,y as sigma) var v =
     (* TODO: handle the case of multiple occs in different scopes *)
     (var,v)::terms,x,termlists,y
 
-let rec match_cases_pattern metas (terms,x,termlists,y as sigma) a1 a2 =
+let match_cases_pattern_list match_fun metas sigma rest x y iter termin lassoc =
+  let rec aux sigma acc rest =
+    try
+      let metas = add_ldots_var (add_meta_term y metas) in
+      let (terms,_,_,_ as sigma) = match_fun metas sigma rest iter in
+      let rest = Id.List.assoc ldots_var terms in
+      let t = Id.List.assoc y terms in
+      let sigma = remove_sigma y (remove_sigma ldots_var sigma) in
+      aux sigma (t::acc) rest
+    with No_match when not (List.is_empty acc) ->
+      acc, match_fun metas sigma rest termin in
+  let l,(terms,onlybinders,termlists,binderlists as sigma) = aux sigma [] rest in
+  (terms,onlybinders,(x,if lassoc then l else List.rev l)::termlists, binderlists)
+
+let rec match_cases_pattern metas (terms,(),termlists,() as sigma) a1 a2 =
  match (a1,a2) with
   | r1, NVar id2 when Id.List.mem_assoc id2 metas -> (bind_env_cases_pattern sigma id2 r1),(0,[])
   | PatVar (_,Anonymous), NHole _ -> sigma,(0,[])
@@ -942,9 +1201,9 @@ let rec match_cases_pattern metas (terms,x,termlists,y as sigma) a1 a2 =
       else
 	let l1',more_args = Util.List.chop le2 l1 in
 	(List.fold_left2 (match_cases_pattern_no_more_args metas) sigma l1' l2),(le2,more_args)
-  | r1, NList (x,_,iter,termin,lassoc) ->
-      (match_alist (match_cases_pattern_no_more_args)
-	metas (terms,(),termlists,()) r1 x iter termin lassoc),(0,[])
+  | r1, NList (x,y,iter,termin,lassoc) ->
+      (match_cases_pattern_list (match_cases_pattern_no_more_args)
+	metas (terms,(),termlists,()) r1 x y iter termin lassoc),(0,[])
   | _ -> raise No_match
 
 and match_cases_pattern_no_more_args metas sigma a1 a2 =
diff --git a/interp/notation_ops.mli b/interp/notation_ops.mli
index 576c5b943..c8fcbf741 100644
--- a/interp/notation_ops.mli
+++ b/interp/notation_ops.mli
@@ -12,7 +12,7 @@ open Glob_term
 
 (** {5 Utilities about [notation_constr]} *)
 
-val eq_notation_constr : notation_constr -> notation_constr -> bool
+val eq_notation_constr : Id.t list * Id.t list -> notation_constr -> notation_constr -> bool
 
 (** Substitution of kernel names in interpretation data                *)
 
@@ -23,13 +23,13 @@ val subst_interpretation :
 
 val ldots_var : Id.t
 
-(** {5 Translation back and forth between [glob_constr] and [notation_constr] *)
+(** {5 Translation back and forth between [glob_constr] and [notation_constr]} *)
 
 (** Translate a [glob_constr] into a notation given the list of variables
     bound by the notation; also interpret recursive patterns           *)
 
 val notation_constr_of_glob_constr : notation_interp_env ->
-  glob_constr -> notation_constr
+  glob_constr -> notation_constr * reversibility_flag
 
 (** Re-interpret a notation as a [glob_constr], taking care of binders *)
 
@@ -40,16 +40,19 @@ val glob_constr_of_notation_constr_with_binders : Loc.t ->
 
 val glob_constr_of_notation_constr : Loc.t -> notation_constr -> glob_constr
 
-(** {5 Matching a notation pattern against a [glob_constr] *)
+(** {5 Matching a notation pattern against a [glob_constr]} *)
 
 (** [match_notation_constr] matches a [glob_constr] against a notation
     interpretation; raise [No_match] if the matching fails   *)
 
 exception No_match
 
+type glob_decl2 =
+    (name, cases_pattern) Util.union * Decl_kinds.binding_kind *
+      glob_constr option * glob_constr
 val match_notation_constr : bool -> glob_constr -> interpretation ->
       (glob_constr * subscopes) list * (glob_constr list * subscopes) list *
-      (glob_decl list * subscopes) list
+      (glob_decl2 list * subscopes) list
 
 val match_notation_constr_cases_pattern :
   cases_pattern -> interpretation ->
@@ -61,5 +64,5 @@ val match_notation_constr_ind_pattern :
   ((cases_pattern * subscopes) list * (cases_pattern list * subscopes) list) *
     (int * cases_pattern list)
 
-(** {5 Matching a notation pattern against a [glob_constr] *)
+(** {5 Matching a notation pattern against a [glob_constr]} *)
 
diff --git a/interp/reserve.ml b/interp/reserve.ml
index 7e42c1a22..a4d4f4027 100644
--- a/interp/reserve.ml
+++ b/interp/reserve.ml
@@ -8,7 +8,7 @@
 
 (* Reserved names *)
 
-open Errors
+open CErrors
 open Util
 open Pp
 open Names
@@ -86,13 +86,13 @@ let in_reserved : Id.t * notation_constr -> obj =
 
 let declare_reserved_type_binding (loc,id) t =
   if not (Id.equal id (root_of_id id)) then
-    user_err_loc(loc,"declare_reserved_type",
-    (pr_id id ++ str
+    user_err ~loc ~hdr:"declare_reserved_type"
+      ((pr_id id ++ str
       " is not reservable: it must have no trailing digits, quote, or _"));
   begin try
     let _ = Id.Map.find id !reserve_table in
-    user_err_loc(loc,"declare_reserved_type",
-    (pr_id id++str" is already bound to a type"))
+    user_err ~loc ~hdr:"declare_reserved_type"
+    ((pr_id id++str" is already bound to a type"))
   with Not_found -> () end;
   add_anonymous_leaf (in_reserved (id,t))
 
diff --git a/interp/smartlocate.ml b/interp/smartlocate.ml
index 1f28ba656..178c1c1f9 100644
--- a/interp/smartlocate.ml
+++ b/interp/smartlocate.ml
@@ -13,7 +13,7 @@
 
 (* *)
 open Pp
-open Errors
+open CErrors
 open Libnames
 open Globnames
 open Misctypes
@@ -46,7 +46,7 @@ let locate_global_with_alias ?(head=false) (loc,qid) =
     if head then global_of_extended_global_head ref
     else global_of_extended_global ref
   with Not_found ->
-    user_err_loc (loc,"",pr_qualid qid ++
+    user_err ~loc  (pr_qualid qid ++
       str " is bound to a notation that does not denote a reference.")
 
 let global_inductive_with_alias r =
@@ -54,14 +54,14 @@ let global_inductive_with_alias r =
   try match locate_global_with_alias lqid with
   | IndRef ind -> ind
   | ref ->
-      user_err_loc (loc_of_reference r,"global_inductive",
-        pr_reference r ++ spc () ++ str "is not an inductive type.")
-  with Not_found -> Nametab.error_global_not_found_loc loc qid
+      user_err ~loc:(loc_of_reference r) ~hdr:"global_inductive"
+        (pr_reference r ++ spc () ++ str "is not an inductive type.")
+  with Not_found -> Nametab.error_global_not_found ~loc qid
 
 let global_with_alias ?head r =
   let (loc,qid as lqid) = qualid_of_reference r in
   try locate_global_with_alias ?head lqid
-  with Not_found -> Nametab.error_global_not_found_loc loc qid
+  with Not_found -> Nametab.error_global_not_found ~loc qid
 
 let smart_global ?head = function
   | AN r ->
diff --git a/interp/stdarg.ml b/interp/stdarg.ml
index 2a7d52e3a..341ff5662 100644
--- a/interp/stdarg.ml
+++ b/interp/stdarg.ml
@@ -6,6 +6,9 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
+open Loc
+open Misctypes
+open Tactypes
 open Genarg
 open Geninterp
 
@@ -29,7 +32,49 @@ let wit_string : string uniform_genarg_type =
 let wit_pre_ident : string uniform_genarg_type =
   make0 ~dyn:(val_tag (topwit wit_string)) "preident"
 
+let loc_of_or_by_notation f = function
+  | AN c -> f c
+  | ByNotation (loc,s,_) -> loc
+
+let wit_int_or_var =
+  make0 ~dyn:(val_tag (topwit wit_int)) "int_or_var"
+
+let wit_intro_pattern =
+  make0 "intropattern"
+
+let wit_ident =
+  make0 "ident"
+
+let wit_var =
+  make0 ~dyn:(val_tag (topwit wit_ident)) "var"
+
+let wit_ref = make0 "ref"
+
+let wit_quant_hyp = make0 "quant_hyp"
+
+let wit_constr =
+  make0 "constr"
+
+let wit_uconstr = make0 "uconstr"
+
+let wit_open_constr = make0 ~dyn:(val_tag (topwit wit_constr)) "open_constr"
+
+let wit_constr_with_bindings = make0 "constr_with_bindings"
+
+let wit_bindings = make0 "bindings"
+
+let wit_red_expr = make0 "redexpr"
+
+let wit_clause_dft_concl  =
+  make0 "clause_dft_concl"
+
 (** Aliases for compatibility *)
 
 let wit_integer = wit_int
 let wit_preident = wit_pre_ident
+let wit_reference = wit_ref
+let wit_global = wit_ref
+let wit_clause = wit_clause_dft_concl
+let wit_quantified_hypothesis = wit_quant_hyp
+let wit_intropattern = wit_intro_pattern
+let wit_redexpr = wit_red_expr
diff --git a/interp/stdarg.mli b/interp/stdarg.mli
index e1f648d7f..af3a73462 100644
--- a/interp/stdarg.mli
+++ b/interp/stdarg.mli
@@ -8,8 +8,21 @@
 
 (** Basic generic arguments. *)
 
+open Loc
+open Names
+open Term
+open Libnames
+open Globnames
+open Genredexpr
+open Pattern
+open Constrexpr
+open Misctypes
+open Tactypes
 open Genarg
 
+(** FIXME: nothing to do there. *)
+val loc_of_or_by_notation : ('a -> Loc.t) -> 'a or_by_notation -> Loc.t
+
 val wit_unit : unit uniform_genarg_type
 
 val wit_bool : bool uniform_genarg_type
@@ -20,7 +33,54 @@ val wit_string : string uniform_genarg_type
 
 val wit_pre_ident : string uniform_genarg_type
 
+(** {5 Additional generic arguments} *)
+
+val wit_int_or_var : (int or_var, int or_var, int) genarg_type
+
+val wit_intro_pattern : (constr_expr intro_pattern_expr located, glob_constr_and_expr intro_pattern_expr located, intro_pattern) genarg_type
+
+val wit_ident : Id.t uniform_genarg_type
+
+val wit_var : (Id.t located, Id.t located, Id.t) genarg_type
+
+val wit_ref : (reference, global_reference located or_var, global_reference) genarg_type
+
+val wit_quant_hyp : quantified_hypothesis uniform_genarg_type
+
+val wit_constr : (constr_expr, glob_constr_and_expr, constr) genarg_type
+
+val wit_uconstr : (constr_expr , glob_constr_and_expr, Glob_term.closed_glob_constr) genarg_type
+
+val wit_open_constr :
+  (constr_expr, glob_constr_and_expr, constr) genarg_type
+
+val wit_constr_with_bindings :
+  (constr_expr with_bindings,
+  glob_constr_and_expr with_bindings,
+  constr with_bindings delayed_open) genarg_type
+
+val wit_bindings :
+  (constr_expr bindings,
+  glob_constr_and_expr bindings,
+  constr bindings delayed_open) genarg_type
+
+val wit_red_expr :
+  ((constr_expr,reference or_by_notation,constr_expr) red_expr_gen,
+  (glob_constr_and_expr,evaluable_global_reference and_short_name or_var,glob_constr_pattern_and_expr) red_expr_gen,
+  (constr,evaluable_global_reference,constr_pattern) red_expr_gen) genarg_type
+
+val wit_clause_dft_concl :  (Names.Id.t Loc.located Locus.clause_expr,Names.Id.t Loc.located Locus.clause_expr,Names.Id.t Locus.clause_expr) genarg_type
+
 (** Aliases for compatibility *)
 
 val wit_integer : int uniform_genarg_type
 val wit_preident : string uniform_genarg_type
+val wit_reference : (reference, global_reference located or_var, global_reference) genarg_type
+val wit_global : (reference, global_reference located or_var, global_reference) genarg_type
+val wit_clause :  (Names.Id.t Loc.located Locus.clause_expr,Names.Id.t Loc.located Locus.clause_expr,Names.Id.t Locus.clause_expr) genarg_type
+val wit_quantified_hypothesis : quantified_hypothesis uniform_genarg_type
+val wit_intropattern : (constr_expr intro_pattern_expr located, glob_constr_and_expr intro_pattern_expr located, intro_pattern) genarg_type
+val wit_redexpr :
+  ((constr_expr,reference or_by_notation,constr_expr) red_expr_gen,
+  (glob_constr_and_expr,evaluable_global_reference and_short_name or_var,glob_constr_pattern_and_expr) red_expr_gen,
+  (constr,evaluable_global_reference,constr_pattern) red_expr_gen) genarg_type
diff --git a/interp/syntax_def.ml b/interp/syntax_def.ml
index 891b64fa1..c3f4c4f30 100644
--- a/interp/syntax_def.ml
+++ b/interp/syntax_def.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-open Errors
+open CErrors
 open Util
 open Pp
 open Names
@@ -30,7 +30,7 @@ let add_syntax_constant kn c onlyparse =
 
 let load_syntax_constant i ((sp,kn),(_,pat,onlyparse)) =
   if Nametab.exists_cci sp then
-    errorlabstrm "cache_syntax_constant"
+    user_err ~hdr:"cache_syntax_constant"
       (pr_id (basename sp) ++ str " already exists");
   add_syntax_constant kn pat onlyparse;
   Nametab.push_syndef (Nametab.Until i) sp kn
@@ -43,7 +43,7 @@ let is_alias_of_already_visible_name sp = function
       false
 
 let open_syntax_constant i ((sp,kn),(_,pat,onlyparse)) =
-  if not (is_alias_of_already_visible_name sp pat) then begin
+  if not (Int.equal i 1 && is_alias_of_already_visible_name sp pat) then begin
     Nametab.push_syndef (Nametab.Exactly i) sp kn;
     match onlyparse with
     | None ->
@@ -84,23 +84,21 @@ let declare_syntactic_definition local id onlyparse pat =
 
 let pr_syndef kn = pr_qualid (shortest_qualid_of_syndef Id.Set.empty kn)
 
-let allow_compat_notations = ref true
-let verbose_compat_notations = ref false
+let pr_compat_warning (kn, def, v) =
+  let pp_def = match def with
+    | [], NRef r -> spc () ++ str "is" ++ spc () ++ pr_global_env Id.Set.empty r
+    | _ -> strbrk " is a compatibility notation"
+  in
+  let since = strbrk " since Coq > " ++ str (Flags.pr_version v) ++ str "." in
+  pr_syndef kn ++ pp_def ++ since
 
-let is_verbose_compat () =
-  !verbose_compat_notations || not !allow_compat_notations
+let warn_compatibility_notation =
+  CWarnings.(create ~name:"compatibility-notation"
+                    ~category:"deprecated" ~default:Disabled pr_compat_warning)
 
 let verbose_compat kn def = function
-  | Some v when is_verbose_compat () && Flags.version_strictly_greater v ->
-    let act =
-      if !verbose_compat_notations then Feedback.msg_warning else errorlabstrm ""
-    in
-    let pp_def = match def with
-      | [], NRef r -> str " is " ++ pr_global_env Id.Set.empty r
-      | _ -> str " is a compatibility notation"
-    in
-    let since = str " since Coq > " ++ str (Flags.pr_version v) ++ str "." in
-    act (pr_syndef kn ++ pp_def ++ since)
+  | Some v when Flags.version_strictly_greater v ->
+     warn_compatibility_notation (kn, def, v)
   | _ -> ()
 
 let search_syntactic_definition kn =
@@ -110,21 +108,3 @@ let search_syntactic_definition kn =
   def
 
 open Goptions
-
-let set_verbose_compat_notations =
-  declare_bool_option
-    { optsync  = true;
-      optdepr  = false;
-      optname  = "verbose compatibility notations";
-      optkey   = ["Verbose";"Compat";"Notations"];
-      optread  = (fun () -> !verbose_compat_notations);
-      optwrite = ((:=) verbose_compat_notations) }
-
-let set_compat_notations =
-  declare_bool_option
-    { optsync  = true;
-      optdepr  = false;
-      optname  = "accept compatibility notations";
-      optkey   = ["Compat"; "Notations"];
-      optread  = (fun () -> !allow_compat_notations);
-      optwrite = ((:=) allow_compat_notations) }
diff --git a/interp/syntax_def.mli b/interp/syntax_def.mli
index 7a1c9c5cb..55e2848e6 100644
--- a/interp/syntax_def.mli
+++ b/interp/syntax_def.mli
@@ -17,9 +17,3 @@ val declare_syntactic_definition : bool -> Id.t ->
   Flags.compat_version option -> syndef_interpretation -> unit
 
 val search_syntactic_definition : kernel_name -> syndef_interpretation
-
-(** Options concerning verbose display of compatibility notations
-    or their deactivation *)
-
-val set_verbose_compat_notations : bool -> unit
-val set_compat_notations : bool -> unit
diff --git a/interp/topconstr.ml b/interp/topconstr.ml
index 91099bbb1..407cec084 100644
--- a/interp/topconstr.ml
+++ b/interp/topconstr.ml
@@ -8,7 +8,7 @@
 
 (*i*)
 open Pp
-open Errors
+open CErrors
 open Util
 open Names
 open Nameops
@@ -22,8 +22,7 @@ open Constrexpr_ops
 let asymmetric_patterns = ref (false)
 let _ = Goptions.declare_bool_option {
   Goptions.optsync = true; Goptions.optdepr = false;
-  Goptions.optname =
-    "Constructors in patterns require all their arguments but no parameters instead of explicit parameters and arguments";
+  Goptions.optname = "no parameters in constructors";
   Goptions.optkey = ["Asymmetric";"Patterns"];
   Goptions.optread = (fun () -> !asymmetric_patterns);
   Goptions.optwrite = (fun a -> asymmetric_patterns:=a);
@@ -32,8 +31,8 @@ let _ = Goptions.declare_bool_option {
 (**********************************************************************)
 (* Miscellaneous *)
 
-let error_invalid_pattern_notation loc =
-  user_err_loc (loc,"",str "Invalid notation for pattern.")
+let error_invalid_pattern_notation ?loc () =
+  user_err ?loc  (str "Invalid notation for pattern.")
 
 (**********************************************************************)
 (* Functions on constr_expr *)
@@ -59,6 +58,7 @@ let rec cases_pattern_fold_names f a = function
   | CPatDelimiters (_,_,pat) -> cases_pattern_fold_names f a pat
   | CPatAtom (_,Some (Ident (_,id))) when not (is_constructor id) -> f id a
   | CPatPrim _ | CPatAtom _ -> a
+  | CPatCast _ -> assert false
 
 let ids_of_pattern_list =
   List.fold_left
@@ -92,6 +92,9 @@ let rec fold_local_binders g f n acc b = function
       f n (fold_local_binders g f n' acc b l) t
   | LocalRawDef ((_,na),t)::l ->
       f n (fold_local_binders g f (name_fold g na n) acc b l) t
+  | LocalPattern (_,pat,t)::l ->
+      let acc = fold_local_binders g f (cases_pattern_fold_names g n pat) acc b l in
+      Option.fold_left (f n) acc t
   | [] ->
       f n acc b
 
@@ -170,9 +173,10 @@ let split_at_annot bl na =
               (List.rev ans, LocalRawAssum (r, k, t) :: rest)
             end
 	| LocalRawDef _ as x :: rest -> aux (x :: acc) rest
+        | LocalPattern _ :: rest -> assert false
 	| [] ->
-            user_err_loc(loc,"",
-			 str "No parameter named " ++ Nameops.pr_id id ++ str".")
+            user_err ~loc 
+			 (str "No parameter named " ++ Nameops.pr_id id ++ str".")
       in aux [] bl
 
 (* Used in correctness and interface *)
@@ -191,7 +195,9 @@ let map_local_binders f g e bl =
       LocalRawAssum(nal,k,ty) ->
         (map_binder g e nal, LocalRawAssum(nal,k,f e ty)::bl)
     | LocalRawDef((loc,na),ty) ->
-        (name_fold g na e, LocalRawDef((loc,na),f e ty)::bl) in
+        (name_fold g na e, LocalRawDef((loc,na),f e ty)::bl)
+    | LocalPattern _ ->
+        assert false in
   let (e,rbl) = List.fold_left h (e,[]) bl in
   (e, List.rev rbl)
 
diff --git a/interp/topconstr.mli b/interp/topconstr.mli
index 58edd4ddf..95d702f8d 100644
--- a/interp/topconstr.mli
+++ b/interp/topconstr.mli
@@ -46,4 +46,4 @@ val patntn_loc :
 
 (** For cases pattern parsing errors *)
 
-val error_invalid_pattern_notation : Loc.t -> 'a
+val error_invalid_pattern_notation : ?loc:Loc.t -> unit -> 'a
diff --git a/intf/constrexpr.mli b/intf/constrexpr.mli
index efd5129b6..0cbb29575 100644
--- a/intf/constrexpr.mli
+++ b/intf/constrexpr.mli
@@ -44,6 +44,8 @@ type raw_cases_pattern_expr =
   | RCPatAtom of Loc.t * Id.t option
   | RCPatOr of Loc.t * raw_cases_pattern_expr list
 
+type instance_expr = Misctypes.glob_level list
+
 type cases_pattern_expr =
   | CPatAlias of Loc.t * cases_pattern_expr * Id.t
   | CPatCstr of Loc.t * reference
@@ -58,14 +60,13 @@ type cases_pattern_expr =
   | CPatPrim of Loc.t * prim_token
   | CPatRecord of Loc.t * (reference * cases_pattern_expr) list
   | CPatDelimiters of Loc.t * string * cases_pattern_expr
+  | CPatCast of Loc.t * cases_pattern_expr * constr_expr
 
 and cases_pattern_notation_substitution =
     cases_pattern_expr list *     (** for constr subterms *)
     cases_pattern_expr list list  (** for recursive notations *)
 
-type instance_expr = Misctypes.glob_level list
-
-type constr_expr =
+and constr_expr =
   | CRef of reference * instance_expr option
   | CFix of Loc.t * Id.t located * fix_expr list
   | CCoFix of Loc.t * Id.t located * cofix_expr list
@@ -124,6 +125,7 @@ and recursion_order_expr =
 and local_binder =
   | LocalRawDef of Name.t located * constr_expr
   | LocalRawAssum of Name.t located list * binder_kind * constr_expr
+  | LocalPattern of Loc.t * cases_pattern_expr * constr_expr option
 
 and constr_notation_substitution =
     constr_expr list *      (** for constr subterms *)
diff --git a/intf/decl_kinds.mli b/intf/decl_kinds.mli
index 6a4e18833..8254b1b80 100644
--- a/intf/decl_kinds.mli
+++ b/intf/decl_kinds.mli
@@ -41,7 +41,7 @@ type definition_object_kind =
 
 type assumption_object_kind = Definitional | Logical | Conjectural
 
-(** [assumption_kind]
+(* [assumption_kind]
 
                 |  Local      | Global
    ------------------------------------
diff --git a/intf/evar_kinds.mli b/intf/evar_kinds.mli
index afc5e3bab..470ad2a23 100644
--- a/intf/evar_kinds.mli
+++ b/intf/evar_kinds.mli
@@ -20,6 +20,7 @@ type t =
   | ImplicitArg of global_reference * (int * Id.t option)
      * bool (** Force inference *)
   | BinderType of Name.t
+  | NamedHole of Id.t (* coming from some ?[id] syntax *)
   | QuestionMark of obligation_definition_status
   | CasesType of bool (* true = a subterm of the type *)
   | InternalHole
diff --git a/intf/genredexpr.mli b/intf/genredexpr.mli
index ff036a13f..16f0c0c92 100644
--- a/intf/genredexpr.mli
+++ b/intf/genredexpr.mli
@@ -8,11 +8,15 @@
 
 (** Reduction expressions *)
 
+open Names
+
 (** The parsing produces initially a list of [red_atom] *)
 
 type 'a red_atom =
   | FBeta
-  | FIota
+  | FMatch
+  | FFix
+  | FCofix
   | FZeta
   | FConst of 'a list
   | FDeltaBut of 'a list
@@ -21,7 +25,9 @@ type 'a red_atom =
 
 type 'a glob_red_flag = {
   rBeta : bool;
-  rIota : bool;
+  rMatch : bool;
+  rFix : bool;
+  rCofix : bool;
   rZeta : bool;
   rDelta : bool; (** true = delta all but rConst; false = delta only on rConst*)
   rConst : 'a list
@@ -46,5 +52,15 @@ type ('a,'b,'c) red_expr_gen =
 type ('a,'b,'c) may_eval =
   | ConstrTerm of 'a
   | ConstrEval of ('a,'b,'c) red_expr_gen * 'a
-  | ConstrContext of (Loc.t * Names.Id.t) * 'a
+  | ConstrContext of (Loc.t * Id.t) * 'a
   | ConstrTypeOf of 'a
+
+open Libnames
+open Constrexpr
+open Misctypes
+
+type r_trm = constr_expr
+type r_pat = constr_pattern_expr
+type r_cst = reference or_by_notation
+
+type raw_red_expr = (r_trm, r_cst, r_pat) red_expr_gen
diff --git a/intf/misctypes.mli b/intf/misctypes.mli
index 1452bbc34..e4f595ac4 100644
--- a/intf/misctypes.mli
+++ b/intf/misctypes.mli
@@ -108,3 +108,31 @@ type 'a or_by_notation =
 (** Kinds of modules *)
 
 type module_kind = Module | ModType | ModAny
+
+(** Various flags *)
+
+type direction_flag = bool (* true = Left-to-right    false = right-to-right *)
+type evars_flag = bool     (* true = pose evars       false = fail on evars *)
+type rec_flag = bool       (* true = recursive        false = not recursive *)
+type advanced_flag = bool  (* true = advanced         false = basic *)
+type letin_flag = bool     (* true = use local def    false = use Leibniz *)
+type clear_flag = bool option (* true = clear hyp, false = keep hyp, None = use default *)
+
+type multi =
+  | Precisely of int
+  | UpTo of int
+  | RepeatStar
+  | RepeatPlus
+
+type 'a core_destruction_arg =
+  | ElimOnConstr of 'a
+  | ElimOnIdent of Id.t Loc.located
+  | ElimOnAnonHyp of int
+
+type 'a destruction_arg =
+  clear_flag * 'a core_destruction_arg
+
+type inversion_kind =
+  | SimpleInversion
+  | FullInversion
+  | FullInversionClear
diff --git a/intf/notation_term.mli b/intf/notation_term.mli
index 7c5d7657b..1ab9980a5 100644
--- a/intf/notation_term.mli
+++ b/intf/notation_term.mli
@@ -73,8 +73,25 @@ type interpretation =
     (Id.t * (subscopes * notation_var_instance_type)) list *
     notation_constr
 
+type reversibility_flag = bool
+
 type notation_interp_env = {
   ninterp_var_type : notation_var_internalization_type Id.Map.t;
   ninterp_rec_vars : Id.t Id.Map.t;
-  mutable ninterp_only_parse : bool;
+}
+
+type grammar_constr_prod_item =
+  | GramConstrTerminal of Tok.t
+  | GramConstrNonTerminal of Extend.constr_prod_entry_key * Id.t option
+  | GramConstrListMark of int * bool
+    (* tells action rule to make a list of the n previous parsed items;
+       concat with last parsed list if true *)
+
+type notation_grammar = {
+  notgram_level : int;
+  notgram_assoc : Extend.gram_assoc option;
+  notgram_notation : Constrexpr.notation;
+  notgram_prods : grammar_constr_prod_item list list;
+  notgram_typs : notation_var_internalization_type list;
+  notgram_onlyprinting : bool;
 }
diff --git a/intf/tactypes.mli b/intf/tactypes.mli
new file mode 100644
index 000000000..b96cb67df
--- /dev/null
+++ b/intf/tactypes.mli
@@ -0,0 +1,35 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+(** Tactic-related types that are not totally Ltac specific and still used in
+    lower API. It's not clear whether this is a temporary API or if this is
+    meant to stay. *)
+
+open Loc
+open Names
+open Constrexpr
+open Glob_term
+open Pattern
+open Misctypes
+
+(** In globalize tactics, we need to keep the initial [constr_expr] to recompute
+   in the environment by the effective calls to Intro, Inversion, etc 
+   The [constr_expr] field is [None] in TacDef though *)
+type glob_constr_and_expr = Glob_term.glob_constr * constr_expr option
+type glob_constr_pattern_and_expr = Id.Set.t * glob_constr_and_expr * constr_pattern
+
+type 'a delayed_open =
+  { delayed : 'r. Environ.env -> 'r Sigma.t -> ('a, 'r) Sigma.sigma }
+
+type delayed_open_constr = Term.constr delayed_open
+type delayed_open_constr_with_bindings = Term.constr with_bindings delayed_open
+
+type intro_pattern = delayed_open_constr intro_pattern_expr located
+type intro_patterns = delayed_open_constr intro_pattern_expr located list
+type or_and_intro_pattern = delayed_open_constr or_and_intro_pattern_expr located
+type intro_pattern_naming = intro_pattern_naming_expr located
diff --git a/intf/vernacexpr.mli b/intf/vernacexpr.mli
index ae9328fcc..8827bc132 100644
--- a/intf/vernacexpr.mli
+++ b/intf/vernacexpr.mli
@@ -8,7 +8,6 @@
 
 open Loc
 open Names
-open Tacexpr
 open Misctypes
 open Constrexpr
 open Decl_kinds
@@ -29,6 +28,7 @@ type class_rawexpr = FunClass | SortClass | RefClass of reference or_by_notation
    similar, they do not seem to mean the same thing. *)
 type goal_selector =
   | SelectNth of int
+  | SelectList of (int * int) list
   | SelectId of Id.t
   | SelectAll
 
@@ -105,7 +105,7 @@ type showable =
   | ShowTree
   | ShowProofNames
   | ShowIntros of bool
-  | ShowMatch of lident
+  | ShowMatch of reference
   | ShowThesis
 
 type comment =
@@ -117,14 +117,25 @@ type reference_or_constr =
   | HintsReference of reference
   | HintsConstr of constr_expr
 
+type hint_mode =
+  | ModeInput (* No evars *)
+  | ModeNoHeadEvar (* No evar at the head *)
+  | ModeOutput (* Anything *)
+
+type 'a hint_info_gen =
+    { hint_priority : int option;
+      hint_pattern : 'a option }
+
+type hint_info_expr = constr_pattern_expr hint_info_gen
+
 type hints_expr =
-  | HintsResolve of (int option * bool * reference_or_constr) list
+  | HintsResolve of (hint_info_expr * bool * reference_or_constr) list
   | HintsImmediate of reference_or_constr list
   | HintsUnfold of reference list
   | HintsTransparency of reference list * bool
-  | HintsMode of reference * bool list
+  | HintsMode of reference * hint_mode list
   | HintsConstructors of reference list
-  | HintsExtern of int * constr_expr option * raw_tactic_expr
+  | HintsExtern of int * constr_expr option * Genarg.raw_generic_argument
 
 type search_restriction =
   | SearchInside of reference list
@@ -165,7 +176,7 @@ type sort_expr = glob_sort
 
 type definition_expr =
   | ProveBody of local_binder list * constr_expr
-  | DefineBody of local_binder list * raw_red_expr option * constr_expr
+  | DefineBody of local_binder list * Genredexpr.raw_red_expr option * constr_expr
       * constr_expr option
 
 type fixpoint_expr =
@@ -205,7 +216,9 @@ type syntax_modifier =
   | SetLevel of int
   | SetAssoc of Extend.gram_assoc
   | SetEntryType of string * Extend.simple_constr_prod_entry_key
-  | SetOnlyParsing of Flags.compat_version
+  | SetOnlyParsing
+  | SetOnlyPrinting
+  | SetCompatVersion of Flags.compat_version
   | SetFormat of string * string located
 
 type proof_end =
@@ -225,7 +238,32 @@ type section_subset_expr =
   | SsSubstr of section_subset_expr * section_subset_expr
   | SsFwdClose of section_subset_expr
 
-(** Extension identifiers for the VERNAC EXTEND mechanism. *)
+(** Extension identifiers for the VERNAC EXTEND mechanism.
+
+    {b ("Extraction", 0} indicates {b Extraction {i qualid}} command.
+
+    {b ("Extraction", 1} indicates {b Recursive Extraction {i qualid}} command.
+
+    {b ("Extraction", 2)} indicates {b Extraction "{i filename}" {i qualid{_ 1}} ... {i qualid{_ n}}} command.
+
+    {b ("ExtractionLibrary", 0)} indicates {b Extraction Library {i ident}} command.
+
+    {b ("RecursiveExtractionLibrary", 0)} indicates {b Recursive Extraction Library {i ident}} command.
+
+    {b ("SeparateExtraction", 0)} indicates {b Separate Extraction {i qualid{_ 1}} ... {i qualid{_ n}}} command.
+
+    {b ("ExtractionLanguage", 0)} indicates {b Extraction Language Ocaml} or {b Extraction Language Haskell} or {b Extraction Language Scheme} or {b Extraction Language JSON} commands.
+
+    {b ("ExtractionImplicit", 0)} indicates {b Extraction Implicit {i qualid} \[ {i ident{_1}} ... {i ident{_n} } \] } command.
+
+    {b ("ExtractionConstant", 0)} indicates {b Extract Constant {i qualid} => {i string}} command.
+
+    {b ("ExtractionInlinedConstant", 0)} indicates {b Extract Inlined Constant {i qualid} => {i string}} command.
+
+    {b ("ExtractionInductive", 0)} indicates {b Extract Inductive {i qualid} => {i string} [ {i string} ... {string} ] {i optstring}} command.
+
+    {b ("ExtractionBlacklist", 0)} indicates {b Extraction Blacklist {i ident{_1}} ... {i ident{_n}}} command.
+ *)
 type extend_name =
   (** Name of the vernac entry where the tactic is defined, typically found
       after the VERNAC EXTEND statement in the source. *)
@@ -314,7 +352,7 @@ type vernac_expr =
   | VernacScheme of (lident option * scheme) list
   | VernacCombinedScheme of lident * lident list
   | VernacUniverse of lident list
-  | VernacConstraint of (lident * Univ.constraint_type * lident) list
+  | VernacConstraint of (glob_level * Univ.constraint_type * glob_level) list
 
   (* Gallina extensions *)
   | VernacBeginSection of lident
@@ -335,12 +373,12 @@ type vernac_expr =
       local_binder list * (* super *)
 	typeclass_constraint * (* instance name, class name, params *)
 	(bool * constr_expr) option * (* props *)
-	int option (* Priority *)
+	hint_info_expr
 
   | VernacContext of local_binder list
 
   | VernacDeclareInstances of
-    reference list * int option (* instance names, priority *)
+    (reference * hint_info_expr) list (* instances names, priorities and patterns *)
 
   | VernacDeclareClass of reference (* inductive or definition name *)
 
@@ -383,10 +421,12 @@ type vernac_expr =
   | VernacDeclareImplicits of reference or_by_notation *
       (explicitation * bool * bool) list list
   | VernacArguments of reference or_by_notation *
-      ((Name.t * bool * (Loc.t * string) option * bool * bool) list) list *
-      int * [ `ReductionDontExposeCase | `ReductionNeverUnfold | `Rename |
-              `ExtraScopes | `Assert | `ClearImplicits | `ClearScopes |
-              `DefaultImplicits ] list
+      vernac_argument_status list (* Main arguments status list *) *
+        (Name.t * vernac_implicit_status) list list (* Extra implicit status lists *) *
+      int option (* Number of args to trigger reduction *) *
+        [ `ReductionDontExposeCase | `ReductionNeverUnfold | `Rename |
+          `ExtraScopes | `Assert | `ClearImplicits | `ClearScopes |
+          `DefaultImplicits ] list
   | VernacArgumentsScope of reference or_by_notation *
       scope_name option list
   | VernacReserve of simple_binder list
@@ -396,13 +436,14 @@ type vernac_expr =
       (Conv_oracle.level * reference or_by_notation list) list
   | VernacUnsetOption of Goptions.option_name
   | VernacSetOption of Goptions.option_name * option_value
+  | VernacSetAppendOption of Goptions.option_name * string
   | VernacAddOption of Goptions.option_name * option_ref_value list
   | VernacRemoveOption of Goptions.option_name * option_ref_value list
   | VernacMemOption of Goptions.option_name * option_ref_value list
   | VernacPrintOption of Goptions.option_name
-  | VernacCheckMayEval of raw_red_expr option * int option * constr_expr
+  | VernacCheckMayEval of Genredexpr.raw_red_expr option * int option * constr_expr
   | VernacGlobalCheck of constr_expr
-  | VernacDeclareReduction of string * raw_red_expr
+  | VernacDeclareReduction of string * Genredexpr.raw_red_expr
   | VernacPrint of printable
   | VernacSearch of searchable * int option * search_restriction
   | VernacLocate of locatable
@@ -428,7 +469,7 @@ type vernac_expr =
   | VernacEndSubproof
   | VernacShow of showable
   | VernacCheckGuard
-  | VernacProof of raw_tactic_expr option * section_subset_expr option
+  | VernacProof of Genarg.raw_generic_argument option * section_subset_expr option
   | VernacProofMode of string
   (* Toplevel control *)
   | VernacToplevelControl of exn
@@ -441,9 +482,14 @@ type vernac_expr =
   | VernacPolymorphic of bool * vernac_expr
   | VernacLocal of bool * vernac_expr
 
-and tacdef_body =
-  | TacticDefinition of Id.t Loc.located * raw_tactic_expr  (* indicates that user employed ':=' in Ltac body *)
-  | TacticRedefinition of reference * raw_tactic_expr       (* indicates that user employed '::=' in Ltac body *)
+and vernac_implicit_status = Implicit | MaximallyImplicit | NotImplicit
+
+and vernac_argument_status = {
+  name : Name.t;
+  recarg_like : bool;
+  notation_scope : (Loc.t * string) option;
+  implicit_status : vernac_implicit_status;
+}
 
 (* A vernac classifier has to tell if a command:
    vernac_when: has to be executed now (alters the parser) or later
@@ -454,7 +500,7 @@ type vernac_type =
   | VtStartProof of vernac_start
   | VtSideff of vernac_sideff_type
   | VtQed of vernac_qed_type
-  | VtProofStep of bool (* parallelize *)
+  | VtProofStep of proof_step
   | VtProofMode of string
   | VtQuery of vernac_part_of_script * report_with
   | VtStm of vernac_control * vernac_part_of_script
@@ -476,6 +522,13 @@ and vernac_control =
 and opacity_guarantee =
   | GuaranteesOpacity (** Only generates opaque terms at [Qed] *)
   | Doesn'tGuaranteeOpacity (** May generate transparent terms even with [Qed].*)
+and proof_step = { (* TODO: inline with OCaml 4.03 *)
+  parallel : [ `Yes of solving_tac * anon_abstracting_tac | `No ];
+  proof_block_detection : proof_block_name option
+}
+and solving_tac = bool (* a terminator *)
+and anon_abstracting_tac = bool (* abstracting anonymously its result *)
+and proof_block_name = string (* open type of delimiters *)
 type vernac_when =
   | VtNow
   | VtLater
diff --git a/kernel/byterun/coq_fix_code.c b/kernel/byterun/coq_fix_code.c
index 29e33d349..d5feafbf9 100644
--- a/kernel/byterun/coq_fix_code.c
+++ b/kernel/byterun/coq_fix_code.c
@@ -57,7 +57,7 @@ void init_arity () {
     arity[MAKEBLOCK1]=arity[MAKEBLOCK2]=arity[MAKEBLOCK3]=arity[MAKEBLOCK4]=
     arity[MAKEACCU]=arity[CONSTINT]=arity[PUSHCONSTINT]=arity[GRABREC]=
     arity[PUSHFIELDS]=arity[GETFIELD]=arity[SETFIELD]=
-    arity[BRANCH]=arity[ISCONST]= 1;
+    arity[BRANCH]=arity[ISCONST]=arity[ENSURESTACKCAPACITY]=1;
   /* instruction with two operands */
   arity[APPTERM]=arity[MAKEBLOCK]=arity[CLOSURE]=
   arity[ARECONST]=arity[PROJ]=2;
@@ -79,7 +79,7 @@ void * coq_stat_alloc (asize_t sz)
 
 value coq_makeaccu (value i) {
   code_t q;
-  code_t res = coq_stat_alloc(8);
+  code_t res = coq_stat_alloc(2 * sizeof(opcode_t));
   q = res;
   *q++ = VALINSTR(MAKEACCU);
   *q = (opcode_t)Int_val(i);
@@ -91,13 +91,13 @@ value coq_pushpop (value i) {
   int n;
   n = Int_val(i);
   if (n == 0) {
-    res = coq_stat_alloc(4);
+    res = coq_stat_alloc(sizeof(opcode_t));
     *res = VALINSTR(STOP);
     return (value)res;
   }
   else {
     code_t q;
-    res = coq_stat_alloc(12);
+    res = coq_stat_alloc(3 * sizeof(opcode_t));
     q = res;
     *q++ = VALINSTR(POP);
     *q++ = (opcode_t)n;
diff --git a/kernel/byterun/coq_instruct.h b/kernel/byterun/coq_instruct.h
index 8c5ab0ecb..d92e85fdf 100644
--- a/kernel/byterun/coq_instruct.h
+++ b/kernel/byterun/coq_instruct.h
@@ -14,6 +14,8 @@
 /* Nota: this list of instructions is parsed to produce derived files */
 /* coq_jumptbl.h and copcodes.ml. Instructions should be uppercase    */
 /* and alone on lines starting by two spaces.                         */
+/* If adding an instruction, DON'T FORGET TO UPDATE coq_fix_code.c    */
+/* with the arity of the instruction and maybe coq_tcode_of_code.     */
 
 enum instructions {
   ACC0, ACC1, ACC2, ACC3, ACC4, ACC5, ACC6, ACC7, ACC,
@@ -37,6 +39,7 @@ enum instructions {
   GETFIELD0, GETFIELD1, GETFIELD, 
   SETFIELD0, SETFIELD1, SETFIELD,
   PROJ,
+  ENSURESTACKCAPACITY,
   CONST0, CONST1, CONST2, CONST3, CONSTINT,
   PUSHCONST0, PUSHCONST1, PUSHCONST2, PUSHCONST3, PUSHCONSTINT,
   ACCUMULATE,
diff --git a/kernel/byterun/coq_interp.c b/kernel/byterun/coq_interp.c
index df5fdce75..af89712d5 100644
--- a/kernel/byterun/coq_interp.c
+++ b/kernel/byterun/coq_interp.c
@@ -23,9 +23,9 @@
 #include "coq_values.h" 
 
 /* spiwack: I append here a few macros for value/number manipulation */
-#define uint32_of_value(val) (((uint32_t)val >> 1))
-#define value_of_uint32(i)   ((value)(((uint32_t)(i) << 1) | 1))
-#define UI64_of_uint32(lo) ((uint64_t)(lo))
+#define uint32_of_value(val) (((uint32_t)(val)) >> 1)
+#define value_of_uint32(i)   ((value)((((uint32_t)(i)) << 1) | 1))
+#define UI64_of_uint32(lo) ((uint64_t)((uint32_t)(lo)))
 #define UI64_of_value(val) (UI64_of_uint32(uint32_of_value(val)))
 /* /spiwack */
 
@@ -76,6 +76,14 @@ sp is a local copy of the global variable extern_sp. */
 #   define print_lint(i)
 #endif
 
+#define CHECK_STACK(num_args) {                                                \
+if (sp - num_args < coq_stack_threshold) {                                     \
+  coq_sp = sp;                                                                 \
+  realloc_coq_stack(num_args + Coq_stack_threshold / sizeof(value));           \
+  sp = coq_sp;                                                                 \
+ }                                                                             \
+}
+
 /* 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; }
@@ -198,6 +206,9 @@ value coq_interprete
   sp = coq_sp;
   pc = coq_pc;
   accu = coq_accu;
+
+  CHECK_STACK(0);
+
 #ifdef THREADED_CODE
   goto *(void *)(coq_jumptbl_base + *pc++); /* Jump to the first instruction */
 #else
@@ -354,7 +365,7 @@ value coq_interprete
 	coq_extra_args = *pc - 1;
 	pc = Code_val(accu);
 	coq_env = accu;
-	goto check_stacks;
+	goto check_stack;
       }
       Instruct(APPLY1) {
 	value arg1 = sp[0];
@@ -371,7 +382,7 @@ value coq_interprete
 	pc = Code_val(accu);
 	coq_env = accu;
 	coq_extra_args = 0;
-	goto check_stacks;
+	goto check_stack;
       }
       Instruct(APPLY2) {
 	value arg1 = sp[0];
@@ -386,7 +397,7 @@ value coq_interprete
 	pc = Code_val(accu);
 	coq_env = accu;
 	coq_extra_args = 1;
-	goto check_stacks;
+	goto check_stack;
       }
       Instruct(APPLY3) {
 	value arg1 = sp[0];
@@ -403,17 +414,13 @@ value coq_interprete
 	pc = Code_val(accu);
 	coq_env = accu;
 	coq_extra_args = 2;
-	goto check_stacks;
+	goto check_stack;
       }
       /* 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;
-      }
+    check_stack:
+      print_instr("check_stack");
+      CHECK_STACK(0);
       /* We also check for signals */
       if (caml_signals_are_pending) {
 	/* If there's a Ctrl-C, we reset the vm */
@@ -422,6 +429,16 @@ value coq_interprete
       }
       Next;
 
+      Instruct(ENSURESTACKCAPACITY) {
+        print_instr("ENSURESTACKCAPACITY");
+        int size = *pc++;
+        /* CHECK_STACK may trigger here a useless allocation because of the
+        threshold, but check_stack: often does it anyway, so we prefer to
+        factorize the code. */
+        CHECK_STACK(size);
+        Next;
+      }
+
       Instruct(APPTERM) {
 	int nargs = *pc++;
 	int slotsize = *pc;
@@ -436,7 +453,7 @@ value coq_interprete
 	pc = Code_val(accu);
 	coq_env = accu;
 	coq_extra_args += nargs - 1;
-	goto check_stacks;
+	goto check_stack;
       }
       Instruct(APPTERM1) {
 	value arg1 = sp[0];
@@ -445,7 +462,7 @@ value coq_interprete
 	sp[0] = arg1;
 	pc = Code_val(accu);
 	coq_env = accu;
-	goto check_stacks;
+	goto check_stack;
       }
       Instruct(APPTERM2) {
 	value arg1 = sp[0];
@@ -458,7 +475,7 @@ value coq_interprete
 	print_lint(accu);
 	coq_env = accu;
 	coq_extra_args += 1;
-	goto check_stacks;
+	goto check_stack;
       }
       Instruct(APPTERM3) {
 	value arg1 = sp[0];
@@ -472,7 +489,7 @@ value coq_interprete
 	pc = Code_val(accu);
 	coq_env = accu;
 	coq_extra_args += 2;
-	goto check_stacks;
+	goto check_stack;
       }
       
       Instruct(RETURN) {
@@ -503,6 +520,7 @@ value coq_interprete
 	int num_args = Wosize_val(coq_env) - 2;
 	int i;
 	print_instr("RESTART");
+        CHECK_STACK(num_args);
 	sp -= num_args;
 	for (i = 0; i < num_args; i++) sp[i] = Field(coq_env, i + 2);
 	coq_env = Field(coq_env, 1);
@@ -539,6 +557,7 @@ value coq_interprete
 	  pc++;/* On saute le Restart */
 	} else {
 	  if (coq_extra_args < rec_pos) {
+            /* Partial application */
 	    mlsize_t num_args, i;
 	    num_args = 1 + coq_extra_args; /* arg1 + extra args */
 	    Alloc_small(accu, num_args + 2, Closure_tag); 
@@ -553,10 +572,10 @@ value coq_interprete
 	  } else {
 	    /* The recursif argument is an accumulator */
 	    mlsize_t num_args, i;
-	    /* Construction of partially applied PF */
+	    /* Construction of fixpoint applied to its [rec_pos-1] first arguments */
 	    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];
+	    Field(accu, 1) = coq_env; // We store the fixpoint in the first field
+	    for (i = 0; i < rec_pos; i++) Field(accu, i + 2) = sp[i]; // Storing args
 	    Code_val(accu) = pc;
 	    sp += rec_pos;
 	    *--sp = accu;
@@ -862,29 +881,7 @@ value coq_interprete
        	sp++;
 	Next; 
       }
-  
-      /* *sp = accu;
-	* Netoyage des cofix *
-        size = Wosize_val(accu);
-        for (i = 2; i < size; i++) {
- 	  accu = Field(*sp, i);
-          if (IS_EVALUATED_COFIX(accu)) {
-            size_aux = Wosize_val(accu);
-            *--sp = accu;
-	    Alloc_small(accu, size_aux, Accu_tag);
-	    for(j = 0; j < size_aux; j++) Field(accu, j) = Field(*sp, j);
-	    *sp = accu;
-	    Alloc_small(accu, 1, ATOM_COFIX_TAG);
-	    Field(accu, 0) = Field(Field(*sp, 1), 0);
-	    caml_modify(&Field(*sp, 1), accu);
-	    accu = *sp; sp++;
-            caml_modify(&Field(*sp, i), accu);
-	  }
-	}
-	sp++;
-	Next; 
-	} */
-      
+       
       Instruct(SETFIELD){
 	print_instr("SETFIELD");
 	caml_modify(&Field(accu, *pc),*sp);
@@ -894,25 +891,58 @@ value coq_interprete
 
 
       Instruct(PROJ){
+        do_proj:
 	print_instr("PROJ");
 	if (Is_accu (accu)) {
-          value block;
-	  /* Skip over the index of projected field */
-	  pc++;
-	  /* Create atom */
-	  Alloc_small(block, 2, ATOM_PROJ_TAG);
-	  Field(block, 0) = Field(coq_global_data, *pc);
-	  Field(block, 1) = accu;
-          accu = block;
-          /* Create accumulator */
-          Alloc_small(block, 2, Accu_tag);
-          Code_val(block) = accumulate;
-          Field(block, 1) = accu;
-          accu = block;
+          *--sp = accu; // Save matched block on stack
+          accu = Field(accu, 1); // Save atom to accu register
+          switch (Tag_val(accu)) {
+          case ATOM_COFIX_TAG: // We are forcing a cofix
+            {
+              mlsize_t i, nargs;
+              sp -= 2;
+              // Push the current instruction as the return address
+              sp[0] = (value)(pc - 1);
+              sp[1] = coq_env;
+              coq_env = Field(accu, 0); // Pointer to suspension
+              accu = sp[2]; // Save accumulator to accu register
+              sp[2] = Val_long(coq_extra_args); // Push number of args for return
+              nargs = Wosize_val(accu) - 2; // Number of args = size of accumulator - 1 (accumulator code) - 1 (atom)
+              // Push arguments to stack
+              CHECK_STACK(nargs + 1);
+              sp -= nargs;
+              for (i = 0; i < nargs; ++i) sp[i] = Field(accu, i + 2);
+              *--sp = accu; // Last argument is the pointer to the suspension
+              coq_extra_args = nargs;
+              pc = Code_val(coq_env); // Trigger evaluation
+              goto check_stack;
+            }
+          case ATOM_COFIXEVALUATED_TAG:
+            {
+              accu = Field(accu, 1);
+              ++sp;
+              goto do_proj;
+            }
+          default:
+            {
+              value block;
+              /* Skip over the index of projected field */
+              ++pc;
+              /* Create atom */
+              Alloc_small(accu, 2, ATOM_PROJ_TAG);
+              Field(accu, 0) = Field(coq_global_data, *pc++);
+              Field(accu, 1) = *sp++;
+              /* Create accumulator */
+              Alloc_small(block, 2, Accu_tag);
+              Code_val(block) = accumulate;
+              Field(block, 1) = accu;
+              accu = block;
+            }
+          }
 	} else {
-	    accu = Field(accu, *pc++);
+          accu = Field(accu, *pc);
+          pc += 2;
 	}
-	pc++;
 	Next;
       }
 
@@ -978,28 +1008,31 @@ value coq_interprete
       }  
       Instruct(MAKESWITCHBLOCK) {
 	print_instr("MAKESWITCHBLOCK");
-	*--sp = accu;
-	accu = Field(accu,1);
+	*--sp = accu; // Save matched block on stack
+	accu = Field(accu,1); // Save atom to accu register
 	switch (Tag_val(accu)) {
-	case ATOM_COFIX_TAG: 
+	case ATOM_COFIX_TAG: // We are forcing a cofix
 	  {
 	    mlsize_t i, nargs;
 	    print_instr("COFIX_TAG");
 	    sp-=2;
 	    pc++;
+            // Push the return address
 	    sp[0] = (value) (pc + *pc);
 	    sp[1] = coq_env;
-	    coq_env = Field(accu,0);
-	    accu = sp[2];
-	    sp[2] = Val_long(coq_extra_args);
-	    nargs = Wosize_val(accu) - 2;
+	    coq_env = Field(accu,0); // Pointer to suspension
+	    accu = sp[2]; // Save accumulator to accu register
+	    sp[2] = Val_long(coq_extra_args); // Push number of args for return
+	    nargs = Wosize_val(accu) - 2; // Number of args = size of accumulator - 1 (accumulator code) - 1 (atom)
+            // Push arguments to stack
+            CHECK_STACK(nargs+1);
 	    sp -= nargs;
-	    for (i = 0; i < nargs; i++) sp[i] = Field(accu, i + 2);
-	    *--sp = accu;
+	    for (i = 0; i < nargs; i++) sp[i] = Field(accu, i + 2); 
+	    *--sp = accu; // Last argument is the pointer to the suspension
 	    print_lint(nargs);
 	    coq_extra_args = nargs;
-	    pc = Code_val(coq_env);
-	    goto check_stacks;
+	    pc = Code_val(coq_env); // Trigger evaluation
+	    goto check_stack;
 	  }
 	case ATOM_COFIXEVALUATED_TAG: 
 	  {
@@ -1024,7 +1057,7 @@ value coq_interprete
 	    annot = *pc++;
 	    sz = *pc++;
 	    *--sp=Field(coq_global_data, annot);
-	    /* On sauve la pile */
+	    /* We save the stack */
 	    if (sz == 0) accu = Atom(0);
 	    else {
 	      Alloc_small(accu, sz, Default_tag);
@@ -1035,17 +1068,17 @@ value coq_interprete
 	      }
 	    }
 	    *--sp = accu;
-	    /* On cree le zipper switch */
+	    /* We create the switch zipper */
 	    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 */
+	    /* We create the atom */
 	    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 */
+	    /* We create the accumulator */
 	    Alloc_small(accu, 2, Accu_tag);
 	    Code_val(accu) = accumulate; 
 	    Field(accu,1) = *sp++;
@@ -1206,7 +1239,7 @@ value coq_interprete
 	  Alloc_small(accu, 2, 1); /* ( _ , arity, tag ) */
 	  /*unsigned shift*/
 	  Field(accu, 0) = (value)((p >> 31)|1) ;  /*higher part*/
-	  Field(accu, 1) = (value)((int32_t)p|1); /*lower part*/
+	  Field(accu, 1) = (value)((uint32_t)p|1); /*lower part*/
 	}
 	Next;
       }
@@ -1457,26 +1490,32 @@ value coq_push_val(value v) {
 
 value coq_push_arguments(value args) {
   int nargs,i;
+  value * sp = coq_sp;
   nargs = Wosize_val(args) - 2;
+  CHECK_STACK(nargs);
   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) {
+value coq_push_vstack(value stk, value max_stack_size) {
   int len,i;
+  value * sp = coq_sp;
   len = Wosize_val(stk);
+  CHECK_STACK(len);
   coq_sp -= len;
   print_instr("push_vstack");print_int(len);
    for(i = 0; i < len; i++) coq_sp[i] = Field(stk,i);
+  sp = coq_sp;
+  CHECK_STACK(uint32_of_value(max_stack_size));
   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");
+  print_instr("end coq_interprete");
 }
 
 value coq_eval_tcode (value tcode, value e) {
diff --git a/kernel/byterun/coq_memory.c b/kernel/byterun/coq_memory.c
index c9bcdc32f..45cfae509 100644
--- a/kernel/byterun/coq_memory.c
+++ b/kernel/byterun/coq_memory.c
@@ -130,6 +130,7 @@ value init_coq_vm(value unit) /* ML */
   return Val_unit;;
 }
 
+/* [required_space] is a size in words */
 void realloc_coq_stack(asize_t required_space)
 {
   asize_t size;
diff --git a/kernel/closure.ml b/kernel/cClosure.ml
index 65123108f..fe9ec5794 100644
--- a/kernel/closure.ml
+++ b/kernel/cClosure.ml
@@ -19,7 +19,7 @@
 (* This file implements a lazy reduction for the Calculus of Inductive
    Constructions *)
 
-open Errors
+open CErrors
 open Util
 open Pp
 open Names
@@ -37,17 +37,20 @@ let delta = ref 0
 let eta = ref 0
 let zeta = ref 0
 let evar = ref 0
-let iota = ref 0
+let nb_match = ref 0
+let fix = ref 0
+let cofix = ref 0
 let prune = ref 0
 
 let reset () =
-  beta := 0; delta := 0; zeta := 0; evar := 0; iota := 0; evar := 0;
-  prune := 0
+  beta := 0; delta := 0; zeta := 0; evar := 0; nb_match := 0; fix := 0;
+  cofix := 0; evar := 0; prune := 0
 
 let stop() =
   Feedback.msg_debug (str "[Reds: beta=" ++ int !beta ++ str" delta=" ++ int !delta ++
 	 str " eta=" ++ int !eta ++ str" zeta=" ++ int !zeta ++ str" evar=" ++
-	 int !evar ++ str" iota=" ++ int !iota ++ str" prune=" ++ int !prune ++
+	 int !evar ++ str" match=" ++ int !nb_match ++ str" fix=" ++ int !fix ++
+         str " cofix=" ++ int !cofix ++ str" prune=" ++ int !prune ++
 	 str"]")
 
 let incr_cnt red cnt =
@@ -78,7 +81,9 @@ module type RedFlagsSig = sig
   val fBETA : red_kind
   val fDELTA : red_kind
   val fETA : red_kind
-  val fIOTA : red_kind
+  val fMATCH : red_kind
+  val fFIX : red_kind
+  val fCOFIX : red_kind
   val fZETA : red_kind
   val fCONST : constant -> red_kind
   val fVAR : Id.t -> red_kind
@@ -103,14 +108,19 @@ module RedFlags = (struct
     r_eta : bool;
     r_const : transparent_state;
     r_zeta : bool;
-    r_iota : bool }
+    r_match : bool;
+    r_fix : bool;
+    r_cofix : bool }
 
-  type red_kind = BETA | DELTA | ETA | IOTA | ZETA
+  type red_kind = BETA | DELTA | ETA | MATCH | FIX
+              | COFIX | ZETA
 	      | CONST of constant | VAR of Id.t
   let fBETA = BETA
   let fDELTA = DELTA
   let fETA = ETA
-  let fIOTA = IOTA
+  let fMATCH = MATCH
+  let fFIX = FIX
+  let fCOFIX = COFIX
   let fZETA = ZETA
   let fCONST kn  = CONST kn
   let fVAR id  = VAR id
@@ -120,7 +130,9 @@ module RedFlags = (struct
     r_eta = false;
     r_const = all_opaque;
     r_zeta = false;
-    r_iota = false }
+    r_match = false;
+    r_fix = false;
+    r_cofix = false }
 
   let red_add red = function
     | BETA -> { red with r_beta = true }
@@ -129,7 +141,9 @@ module RedFlags = (struct
     | CONST kn ->
 	let (l1,l2) = red.r_const in
 	{ red with r_const = l1, Cpred.add kn l2 }
-    | IOTA -> { red with r_iota = true }
+    | MATCH -> { red with r_match = true }
+    | FIX -> { red with r_fix = true }
+    | COFIX -> { red with r_cofix = true }
     | ZETA -> { red with r_zeta = true }
     | VAR id ->
 	let (l1,l2) = red.r_const in
@@ -140,9 +154,11 @@ module RedFlags = (struct
     | ETA -> { red with r_eta = false }
     | DELTA -> { red with r_delta = false }
     | CONST kn ->
- 	let (l1,l2) = red.r_const in
+	let (l1,l2) = red.r_const in
 	{ red with r_const = l1, Cpred.remove kn l2 }
-    | IOTA -> { red with r_iota = false }
+    | MATCH -> { red with r_match = false }
+    | FIX -> { red with r_fix = false }
+    | COFIX -> { red with r_cofix = false }
     | ZETA -> { red with r_zeta = false }
     | VAR id ->
 	let (l1,l2) = red.r_const in
@@ -165,11 +181,13 @@ module RedFlags = (struct
 	let c = Id.Pred.mem id l in
 	incr_cnt c delta
     | ZETA -> incr_cnt red.r_zeta zeta
-    | IOTA -> incr_cnt red.r_iota iota
+    | MATCH -> incr_cnt red.r_match nb_match
+    | FIX -> incr_cnt red.r_fix fix
+    | COFIX -> incr_cnt red.r_cofix cofix
     | DELTA -> (* Used for Rel/Var defined in context *)
 	incr_cnt red.r_delta delta
 
-  let red_projection red p = 
+  let red_projection red p =
     if Projection.unfolded p then true
     else red_set red (fCONST (Projection.constant p))
 
@@ -177,15 +195,20 @@ end : RedFlagsSig)
 
 open RedFlags
 
-let betadeltaiota = mkflags [fBETA;fDELTA;fZETA;fIOTA]
-let betadeltaiotanolet = mkflags [fBETA;fDELTA;fIOTA]
-let betaiota = mkflags [fBETA;fIOTA]
+let all = mkflags [fBETA;fDELTA;fZETA;fMATCH;fFIX;fCOFIX]
+let allnolet = mkflags [fBETA;fDELTA;fMATCH;fFIX;fCOFIX]
 let beta = mkflags [fBETA]
-let betaiotazeta = mkflags [fBETA;fIOTA;fZETA]
+let betadeltazeta = mkflags [fBETA;fDELTA;fZETA]
+let betaiota = mkflags [fBETA;fMATCH;fFIX;fCOFIX]
+let betaiotazeta = mkflags [fBETA;fMATCH;fFIX;fCOFIX;fZETA]
+let betazeta = mkflags [fBETA;fZETA]
+let delta = mkflags [fDELTA]
+let zeta = mkflags [fZETA]
+let nored = no_red
 
 (* Removing fZETA for finer behaviour would break many developments *)
-let unfold_side_flags = [fBETA;fIOTA;fZETA]
-let unfold_side_red = mkflags [fBETA;fIOTA;fZETA]
+let unfold_side_flags = [fBETA;fMATCH;fFIX;fCOFIX;fZETA]
+let unfold_side_red = mkflags [fBETA;fMATCH;fFIX;fCOFIX;fZETA]
 let unfold_red kn =
   let flag = match kn with
     | EvalVarRef id -> fVAR id
@@ -215,7 +238,7 @@ type table_key = constant puniverses tableKey
 
 let eq_pconstant_key (c,u) (c',u') =
   eq_constant_key c c' && Univ.Instance.equal u u'
-  
+
 module IdKeyHash =
 struct
   open Hashset.Combine
@@ -238,7 +261,7 @@ type 'a infos_cache = {
   i_rels : constr option array;
   i_tab : 'a KeyTable.t }
 
-and 'a infos = { 
+and 'a infos = {
   i_flags : reds;
   i_cache : 'a infos_cache }
 
@@ -247,11 +270,9 @@ let info_env info = info.i_cache.i_env
 
 open Context.Named.Declaration
 
-let rec assoc_defined id = function
-| [] -> raise Not_found
-| LocalAssum _ :: ctxt -> assoc_defined id ctxt
-| LocalDef (id', c, _) :: ctxt ->
-  if Id.equal id id' then c else assoc_defined id ctxt
+let assoc_defined id env = match Environ.lookup_named id env with
+| LocalDef (_, c, _) -> c
+| _ -> raise Not_found
 
 let ref_value_cache ({i_cache = cache} as infos)  ref =
   try
@@ -268,7 +289,7 @@ let ref_value_cache ({i_cache = cache} as infos)  ref =
             | None -> raise Not_found
             | Some t -> lift n t
             end
-	| VarKey id -> assoc_defined id (named_context cache.i_env)
+	| VarKey id -> assoc_defined id cache.i_env
 	| ConstKey cst -> constant_value_in cache.i_env cst
     in
     let v = cache.i_repr infos body in
@@ -297,7 +318,7 @@ let defined_rels flags env =
 (*  else (0,[])*)
 
 let create mk_cl flgs env evars =
-  let cache = 
+  let cache =
     { i_repr = mk_cl;
       i_env = env;
       i_sigma = evars;
@@ -363,6 +384,7 @@ let set_norm v = v.norm <- Norm
 let is_val v = match v.norm with Norm -> true | _ -> false
 
 let mk_atom c = {norm=Norm;term=FAtom c}
+let mk_red f = {norm=Red;term=f}
 
 (* Could issue a warning if no is still Red, pointing out that we loose
    sharing. *)
@@ -646,7 +668,7 @@ let rec zip m stk =
     | ZcaseT(ci,p,br,e)::s ->
         let t = FCaseT(ci, p, m, br, e) in
         zip {norm=neutr m.norm; term=t} s
-    | Zproj (i,j,cst) :: s -> 
+    | Zproj (i,j,cst) :: s ->
         zip {norm=neutr m.norm; term=FProj(Projection.make cst true,m)} s
     | Zfix(fx,par)::s ->
         zip fx (par @ append_stack [|m|] s)
@@ -753,7 +775,7 @@ let rec try_drop_parameters depth n argstk =
           let aft = Array.sub args n (q-n) in
           reloc_rargs depth (append_stack aft s)
     | Zshift(k)::s -> try_drop_parameters (depth-k) n s
-    | [] -> 
+    | [] ->
 	if Int.equal n 0 then []
 	else raise Not_found
     | _ -> assert false
@@ -762,23 +784,23 @@ let rec try_drop_parameters depth n argstk =
 let drop_parameters depth n argstk =
   try try_drop_parameters depth n argstk
   with Not_found ->
-  (* we know that n < stack_args_size(argstk) (if well-typed term) *) 
+  (* we know that n < stack_args_size(argstk) (if well-typed term) *)
   anomaly (Pp.str "ill-typed term: found a match on a partially applied constructor")
 
 (** [eta_expand_ind_stack env ind c s t] computes stacks corresponding
-    to the conversion of the eta expansion of t, considered as an inhabitant 
+    to the conversion of the eta expansion of t, considered as an inhabitant
     of ind, and the Constructor c of this inductive type applied to arguments
     s.
     @assumes [t] is an irreducible term, and not a constructor. [ind] is the inductive
-    of the constructor term [c] 
-    @raises Not_found if the inductive is not a primitive record, or if the 
+    of the constructor term [c]
+    @raises Not_found if the inductive is not a primitive record, or if the
     constructor is partially applied.
  *)
 let eta_expand_ind_stack env ind m s (f, s') =
   let mib = lookup_mind (fst ind) env in
     match mib.Declarations.mind_record with
     | Some (Some (_,projs,pbs)) when
-	mib.Declarations.mind_finite == Decl_kinds.BiFinite -> 
+	mib.Declarations.mind_finite == Decl_kinds.BiFinite ->
 	(* (Construct, pars1 .. parsm :: arg1...argn :: []) ~= (f, s') ->
 	   arg1..argn ~= (proj1 t...projn t) where t = zip (f,s') *)
       let pars = mib.Declarations.mind_nparams in
@@ -788,12 +810,12 @@ let eta_expand_ind_stack env ind m s (f, s') =
       let argss = try_drop_parameters depth pars args in
       let hstack = Array.map (fun p -> { norm = Red; (* right can't be a constructor though *)
 					 term = FProj (Projection.make p true, right) }) projs in
-	argss, [Zapp hstack]	
+	argss, [Zapp hstack]
     | _ -> raise Not_found (* disallow eta-exp for non-primitive records *)
 
 let rec project_nth_arg n argstk =
   match argstk with
-  | Zapp args :: s -> 
+  | Zapp args :: s ->
       let q = Array.length args in
 	if n >= q then project_nth_arg (n - q) s
 	else (* n < q *) args.(n)
@@ -848,7 +870,7 @@ let rec knh info m stk =
           (match try Some (lookup_projection p (info_env info)) with Not_found -> None with
 	  | None -> (m, stk)
 	  | Some pb ->
-	     knh info c (Zproj (pb.Declarations.proj_npars, pb.Declarations.proj_arg, 
+	     knh info c (Zproj (pb.Declarations.proj_npars, pb.Declarations.proj_arg,
 				Projection.constant p)
 			 :: zupdate m stk))
 	else (m,stk)
@@ -895,23 +917,27 @@ let rec knr info m stk =
       (match ref_value_cache info (RelKey k) with
           Some v -> kni info v stk
         | None -> (set_norm m; (m,stk)))
-  | FConstruct((ind,c),u) when red_set info.i_flags fIOTA ->
+  | FConstruct((ind,c),u) ->
+     let use_match = red_set info.i_flags fMATCH in
+     let use_fix = red_set info.i_flags fFIX in
+     if use_match || use_fix then
       (match strip_update_shift_app m stk with
-        | (depth, args, ZcaseT(ci,_,br,e)::s) ->
+        | (depth, args, ZcaseT(ci,_,br,e)::s) when use_match ->
             assert (ci.ci_npar>=0);
             let rargs = drop_parameters depth ci.ci_npar args in
             knit info e br.(c-1) (rargs@s)
-        | (_, cargs, Zfix(fx,par)::s) ->
+        | (_, cargs, Zfix(fx,par)::s) when use_fix ->
             let rarg = fapp_stack(m,cargs) in
             let stk' = par @ append_stack [|rarg|] s in
             let (fxe,fxbd) = contract_fix_vect fx.term in
             knit info fxe fxbd stk'
-	| (depth, args, Zproj (n, m, cst)::s) ->
+	| (depth, args, Zproj (n, m, cst)::s) when use_match ->
 	    let rargs = drop_parameters depth n args in
 	    let rarg = project_nth_arg m rargs in
 	      kni info rarg s
         | (_,args,s) -> (m,args@s))
-  | FCoFix _ when red_set info.i_flags fIOTA ->
+     else (m,stk)
+  | FCoFix _ when red_set info.i_flags fCOFIX ->
       (match strip_update_shift_app m stk with
           (_, args, (((ZcaseT _|Zproj _)::_) as stk')) ->
             let (fxe,fxbd) = contract_fix_vect m.term in
@@ -946,8 +972,8 @@ let rec zip_term zfun m stk =
         let t = mkCase(ci, zfun (mk_clos e p), m,
 		       Array.map (fun b -> zfun (mk_clos e b)) br) in
         zip_term zfun t s
-    | Zproj(_,_,p)::s -> 
-        let t = mkProj (Projection.make p true, m) in 
+    | Zproj(_,_,p)::s ->
+        let t = mkProj (Projection.make p true, m) in
 	zip_term zfun t s
     | Zfix(fx,par)::s ->
         let h = mkApp(zip_term zfun (zfun fx) par,[|m|]) in
@@ -1027,18 +1053,17 @@ let oracle_of_infos infos = Environ.oracle infos.i_cache.i_env
 
 let env_of_infos infos = infos.i_cache.i_env
 
-let infos_with_reds infos reds = 
+let infos_with_reds infos reds =
   { infos with i_flags = reds }
 
-let unfold_reference info key = 
+let unfold_reference info key =
   match key with
   | ConstKey (kn,_) ->
     if red_set info.i_flags (fCONST kn) then
-      ref_value_cache info key  
+      ref_value_cache info key
     else None
-  | VarKey i -> 
+  | VarKey i ->
     if red_set info.i_flags (fVAR i) then
       ref_value_cache info key
     else None
   | _ -> ref_value_cache info key
-  
diff --git a/kernel/closure.mli b/kernel/cClosure.mli
index 07176cb7d..077756ac7 100644
--- a/kernel/closure.mli
+++ b/kernel/cClosure.mli
@@ -41,8 +41,10 @@ module type RedFlagsSig = sig
   val fBETA : red_kind
   val fDELTA : red_kind
   val fETA : red_kind
-  (** This flag is never used by the kernel reduction but pretyping does *)
-  val fIOTA : red_kind
+  (** The fETA flag is never used by the kernel reduction but pretyping does *)
+  val fMATCH : red_kind
+  val fFIX : red_kind
+  val fCOFIX : red_kind
   val fZETA : red_kind
   val fCONST : constant -> red_kind
   val fVAR : Id.t -> red_kind
@@ -64,7 +66,7 @@ module type RedFlagsSig = sig
 
   (** Tests if a reduction kind is set *)
   val red_set : reds -> red_kind -> bool
-    
+
   (** This tests if the projection is in unfolded state already or
       is unfodable due to delta. *)
   val red_projection : reds -> projection -> bool
@@ -73,11 +75,18 @@ end
 module RedFlags : RedFlagsSig
 open RedFlags
 
-val beta               : reds
-val betaiota           : reds
-val betadeltaiota      : reds
-val betaiotazeta       : reds
-val betadeltaiotanolet : reds
+(* These flags do not contain eta *)
+val all               : reds
+val allnolet          : reds
+val beta              : reds
+val betadeltazeta     : reds
+val betaiota          : reds
+val betaiotazeta      : reds
+val betazeta          : reds
+val delta             : reds
+val zeta              : reds
+val nored             : reds
+
 
 val unfold_side_red : reds
 val unfold_red : evaluable_global_reference -> reds
@@ -86,7 +95,7 @@ val unfold_red : evaluable_global_reference -> reds
 type table_key = constant puniverses tableKey
 
 type 'a infos_cache
-type 'a infos = { 
+type 'a infos = {
   i_flags : reds;
   i_cache : 'a infos_cache }
 
@@ -164,6 +173,9 @@ val inject : constr -> fconstr
 (** mk_atom: prevents a term from being evaluated *)
 val mk_atom : constr -> fconstr
 
+(** mk_red: makes a reducible term (used in newring) *)
+val mk_red : fterm -> fconstr
+
 val fterm_of : fconstr -> fterm
 val term_of_fconstr : fconstr -> constr
 val destFLambda :
@@ -192,16 +204,16 @@ val whd_val : clos_infos -> fconstr -> constr
 val whd_stack :
   clos_infos -> fconstr -> stack -> fconstr * stack
 
-(** [eta_expand_ind_stack env ind c s t] computes stacks correspoding 
-    to the conversion of the eta expansion of t, considered as an inhabitant 
+(** [eta_expand_ind_stack env ind c s t] computes stacks correspoding
+    to the conversion of the eta expansion of t, considered as an inhabitant
     of ind, and the Constructor c of this inductive type applied to arguments
     s.
     @assumes [t] is a rigid term, and not a constructor. [ind] is the inductive
-    of the constructor term [c] 
-    @raises Not_found if the inductive is not a primitive record, or if the 
+    of the constructor term [c]
+    @raises Not_found if the inductive is not a primitive record, or if the
     constructor is partially applied.
  *)
-val eta_expand_ind_stack : env -> inductive -> fconstr -> stack -> 
+val eta_expand_ind_stack : env -> inductive -> fconstr -> stack ->
    (fconstr * stack) -> stack * stack
 
 (** Conversion auxiliary functions to do step by step normalisation *)
diff --git a/kernel/cbytecodes.ml b/kernel/cbytecodes.ml
index 09afbb575..94ca4c72d 100644
--- a/kernel/cbytecodes.ml
+++ b/kernel/cbytecodes.ml
@@ -43,7 +43,7 @@ type structured_constant =
 type reloc_table = (tag * int) array
 
 type annot_switch =
-   {ci : case_info; rtbl : reloc_table; tailcall : bool}
+   {ci : case_info; rtbl : reloc_table; tailcall : bool; max_stack_size : int}
 
 module Label =
   struct
@@ -87,6 +87,7 @@ type instruction =
   | Ksequence of bytecodes * bytecodes
   | Kproj of int * Constant.t  (* index of the projected argument,
                                            name of projection *)
+  | Kensurestackcapacity of int
 (* spiwack: instructions concerning integers *)
   | Kbranch of Label.t                  (* jump to label *)
   | Kaddint31                           (* adds the int31 in the accu
@@ -142,11 +143,29 @@ type fv = fv_elem array
 exception NotClosed
 
 
+module Fv_elem =
+struct
+type t = fv_elem
+
+let compare e1 e2 = match e1, e2 with
+| FVnamed id1, FVnamed id2 -> Id.compare id1 id2
+| FVnamed _, _ -> -1
+| FVrel _, FVnamed _ -> 1
+| FVrel r1, FVrel r2 -> Int.compare r1 r2
+| FVrel _, FVuniv_var _ -> -1
+| FVuniv_var i1, FVuniv_var i2 -> Int.compare i1 i2
+| FVuniv_var i1, _ -> 1
+
+end
+
+module FvMap = Map.Make(Fv_elem)
+
 (*spiwack: both type have been moved from Cbytegen because I needed then
   for the retroknowledge *)
 type vm_env = {
     size : int;              (* longueur de la liste [n] *)
-    fv_rev : fv_elem list    (* [fvn; ... ;fv1] *)
+    fv_rev : fv_elem list;   (* [fvn; ... ;fv1] *)
+    fv_fwd : int FvMap.t;    (* reverse mapping *)
   }
 
 
@@ -246,6 +265,8 @@ let rec pp_instr i =
 
   | Kproj(n,p) -> str "proj " ++ int n ++ str " " ++ Constant.print p
 
+  | Kensurestackcapacity size -> str "growstack " ++ int size
+
   | Kaddint31 -> str "addint31"
   | Kaddcint31 -> str "addcint31"
   | Kaddcarrycint31 -> str "addcarrycint31"
diff --git a/kernel/cbytecodes.mli b/kernel/cbytecodes.mli
index 6fa0841af..b8de7619c 100644
--- a/kernel/cbytecodes.mli
+++ b/kernel/cbytecodes.mli
@@ -39,7 +39,7 @@ val pp_struct_const : structured_constant -> Pp.std_ppcmds
 type reloc_table = (tag * int) array
 
 type annot_switch =
-   {ci : case_info; rtbl : reloc_table; tailcall : bool}
+   {ci : case_info; rtbl : reloc_table; tailcall : bool; max_stack_size : int}
 
 module Label :
   sig
@@ -84,6 +84,7 @@ type instruction =
   | Ksequence of bytecodes * bytecodes
   | Kproj of int * Constant.t  (** index of the projected argument,
                                             name of projection *)
+  | Kensurestackcapacity of int
 
 (** spiwack: instructions concerning integers *)
   | Kbranch of Label.t                  (** jump to label, is it needed ? *)
@@ -139,11 +140,14 @@ type fv = fv_elem array
             closed terms. *)
 exception NotClosed
 
+module FvMap : Map.S with type key = fv_elem
+
 (*spiwack: both type have been moved from Cbytegen because I needed them
   for the retroknowledge *)
 type vm_env = {
     size : int;              (** length of the list [n] *)
-    fv_rev : fv_elem list    (** [fvn; ... ;fv1] *)
+    fv_rev : fv_elem list;   (** [fvn; ... ;fv1] *)
+    fv_fwd : int FvMap.t;    (** reverse mapping *)
   }
 
 
diff --git a/kernel/cbytegen.ml b/kernel/cbytegen.ml
index 431c914c0..57b397e6f 100644
--- a/kernel/cbytegen.ml
+++ b/kernel/cbytegen.ml
@@ -91,9 +91,19 @@ open Pre_env
 (* In Cfxe_t accumulators, we need to store [fcofixi] for testing         *)
 (* conversion of cofixpoints (which is intentional).                      *)
 
+module Config = struct
+  let stack_threshold = 256 (* see byterun/coq_memory.h *)
+  let stack_safety_margin = 15
+end
+
 type argument = ArgConstr of Constr.t | ArgUniv of Univ.Level.t
 
-let empty_fv = { size= 0;  fv_rev = [] }
+let empty_fv = { size= 0;  fv_rev = []; fv_fwd = FvMap.empty }
+let push_fv d e = {
+  size = e.size + 1;
+  fv_rev = d :: e.fv_rev;
+  fv_fwd = FvMap.add d e.size e.fv_fwd;
+}
 
 let fv r = !(r.in_env)
 
@@ -107,6 +117,26 @@ let empty_comp_env ?(univs=0) ()=
     in_env = ref empty_fv
   }
 
+(* Maximal stack size reached during the current function body. Used to
+   reallocate the stack if we lack space. *)
+let max_stack_size = ref 0
+
+let set_max_stack_size stack_size =
+  if stack_size > !max_stack_size then
+    max_stack_size := stack_size
+
+let ensure_stack_capacity f x =
+  let old = !max_stack_size in
+  max_stack_size := 0;
+  let code = f x in
+  let used_safe =
+    !max_stack_size + Config.stack_safety_margin
+  in
+  max_stack_size := old;
+  if used_safe > Config.stack_threshold then
+    Kensurestackcapacity used_safe :: code
+  else code
+
 (*i Creation functions for comp_env *)
 
 let rec add_param n sz l =
@@ -184,20 +214,15 @@ let push_local sz r =
     in_stack = (sz + 1) :: r.in_stack }
 
 (*i Compilation of variables *)
-let find_at f l =
-  let rec aux n = function
-    | [] -> raise Not_found
-    | hd :: tl -> if f hd then n else aux (n + 1) tl
-  in aux 1 l
+let find_at fv env = FvMap.find fv env.fv_fwd
 
 let pos_named id r =
   let env = !(r.in_env) in
   let cid = FVnamed id in
-  let f = function FVnamed id' -> Id.equal id id' | _ -> false in
-  try Kenvacc(r.offset + env.size - (find_at f env.fv_rev))
+  try Kenvacc(r.offset + find_at cid env)
   with Not_found ->
     let pos = env.size in
-    r.in_env := { size = pos+1; fv_rev =  cid:: env.fv_rev};
+    r.in_env := push_fv cid env;
     Kenvacc (r.offset + pos)
 
 let pos_rel i r sz =
@@ -212,11 +237,10 @@ let pos_rel i r sz =
       let i = i - r.nb_rec in
       let db = FVrel(i) in
       let env = !(r.in_env) in
-      let f = function FVrel j -> Int.equal i j | _ -> false in
-      try Kenvacc(r.offset + env.size - (find_at f env.fv_rev))
+      try Kenvacc(r.offset + find_at db env)
       with Not_found ->
 	let pos = env.size in
-	r.in_env := { size = pos+1; fv_rev =  db:: env.fv_rev};
+	r.in_env := push_fv db env;
 	Kenvacc(r.offset + pos)
 
 let pos_universe_var i r sz =
@@ -224,15 +248,11 @@ let pos_universe_var i r sz =
     Kacc (sz - r.nb_stack - (r.nb_uni_stack - i))
   else
     let env = !(r.in_env) in
-    let f = function
-      | FVuniv_var u -> Int.equal i u
-      | _ -> false
-    in
-    try Kenvacc (r.offset + env.size - (find_at f env.fv_rev))
+    let db = FVuniv_var i in
+    try Kenvacc (r.offset + find_at db env)
     with Not_found ->
       let pos = env.size in
-      let db = FVuniv_var i in
-      r.in_env := { size = pos + 1; fv_rev = db::env.fv_rev } ;
+      r.in_env := push_fv db env;
       Kenvacc(r.offset + pos)
 
 (*i  Examination of the continuation *)
@@ -375,14 +395,28 @@ let const_bn tag args =
   else
     Const_bn(last_variant_tag, Array.append [|Const_b0 (tag - last_variant_tag) |] args)
 
-  
-let code_makeblock arity tag cont = 
+(*
+If [tag] hits the OCaml limitation for non constant constructors, we switch to
+another representation for the remaining constructors:
+[last_variant_tag|tag - last_variant_tag|args]
+
+We subtract last_variant_tag for efficiency of match interpretation.
+ *)
+
+let nest_block tag arity cont =
+  Kconst (Const_b0 (tag - last_variant_tag)) ::
+    Kmakeblock(arity+1, last_variant_tag) :: cont
+
+let code_makeblock ~stack_size ~arity ~tag cont = 
   if tag < last_variant_tag then
     Kmakeblock(arity, tag) :: cont
-  else
-    Kpush :: Kconst (Const_b0 (tag - last_variant_tag)) ::
-    Kmakeblock(arity+1, last_variant_tag) :: cont
+  else begin
+    set_max_stack_size (stack_size + 1);
+    Kpush :: nest_block tag arity cont
+  end
 
+(* [code_construct] compiles an abstracted constructor dropping parameters and
+   updates [fun_code] *)
 (* Inv : nparam + arity > 0 *)
 let code_construct tag nparams arity cont =
   let f_cont =
@@ -391,11 +425,11 @@ let code_construct tag nparams arity cont =
 	[Kconst (Const_b0 tag); Kreturn 0]
        else if tag < last_variant_tag then
          [Kacc 0; Kpop 1; Kmakeblock(arity, tag); Kreturn 0]
-       else 
-         [Kconst (Const_b0 (tag - last_variant_tag)); 
-          Kmakeblock(arity+1, last_variant_tag); Kreturn 0])
+       else
+         nest_block tag arity [Kreturn 0])
     in
     let lbl = Label.create() in
+    (* No need to grow the stack here, as the function does not push stuff. *)
     fun_code := [Ksequence (add_grab (nparams+arity) lbl f_cont,!fun_code)];
     Kclosure(lbl,0) :: cont
 
@@ -511,6 +545,7 @@ let comp_args comp_expr reloc args sz cont =
   done;
   !c
 
+(* Precondition: args not empty *)
 let comp_app comp_fun comp_arg reloc f args sz cont =
   let nargs = Array.length args in
   match is_tailcall cont with
@@ -540,11 +575,12 @@ let compile_fv_elem reloc fv sz cont =
 let rec compile_fv reloc l sz cont =
   match l with
   | [] -> cont
-  | [fvn] -> compile_fv_elem reloc fvn sz cont
+  | [fvn] -> set_max_stack_size (sz + 1); compile_fv_elem reloc fvn sz cont
   | fvn :: tl ->
       compile_fv_elem reloc fvn sz
 	(Kpush :: compile_fv reloc tl (sz + 1) cont)
 
+
 (* Compiling constants *)
 
 let rec get_alias env kn =
@@ -559,6 +595,7 @@ let rec get_alias env kn =
 
 (* sz is the size of the local stack *)
 let rec compile_constr reloc c sz cont =
+  set_max_stack_size sz;
   match kind_of_term c with
   | Meta _ -> invalid_arg "Cbytegen.compile_constr : Meta"
   | Evar _ -> invalid_arg "Cbytegen.compile_constr : Evar"
@@ -607,6 +644,7 @@ let rec compile_constr reloc c sz cont =
 	compile_str_cst reloc (Bstrconst (Const_sorts (Type uglob))) sz cont
       else
 	let compile_get_univ reloc idx sz cont =
+          set_max_stack_size sz;
 	  compile_fv_elem reloc (FVuniv_var idx) sz cont
 	in
         comp_app compile_str_cst compile_get_univ reloc
@@ -626,7 +664,8 @@ let rec compile_constr reloc c sz cont =
       let r_fun = comp_env_fun arity in
       let lbl_fun = Label.create() in
       let cont_fun =
-	compile_constr r_fun body arity [Kreturn arity] in
+        ensure_stack_capacity (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)
@@ -646,9 +685,10 @@ let rec compile_constr reloc c sz cont =
       (* Compilation des types *)
       let env_type = comp_env_fix_type rfv in
       for i = 0 to ndef - 1 do
-	let lbl,fcode =
-	  label_code
-	    (compile_constr env_type type_bodies.(i) 0 [Kstop]) in
+        let fcode =
+          ensure_stack_capacity (compile_constr env_type type_bodies.(i) 0) [Kstop]
+        in
+	let lbl,fcode = label_code fcode in
 	lbl_types.(i) <- lbl;
 	fun_code := [Ksequence(fcode,!fun_code)]
       done;
@@ -658,7 +698,8 @@ let rec compile_constr reloc c sz cont =
 	let arity = List.length params in
 	let env_body = comp_env_fix ndef i arity rfv in
 	let cont1 =
-	  compile_constr env_body body arity [Kreturn arity] in
+	  ensure_stack_capacity (compile_constr env_body body arity) [Kreturn arity]
+        in
 	let lbl = Label.create () in
 	lbl_bodies.(i) <- lbl;
 	let fcode =  add_grabrec rec_args.(i) arity lbl cont1 in
@@ -676,9 +717,10 @@ let rec compile_constr reloc c sz cont =
       let rfv = ref empty_fv in
       let env_type = comp_env_cofix_type ndef rfv in
       for i = 0 to ndef - 1 do
-	let lbl,fcode =
-	  label_code
-	    (compile_constr env_type type_bodies.(i) 0 [Kstop]) in
+        let fcode =
+          ensure_stack_capacity (compile_constr env_type type_bodies.(i) 0) [Kstop]
+        in
+	let lbl,fcode = label_code fcode in
 	lbl_types.(i) <- lbl;
 	fun_code := [Ksequence(fcode,!fun_code)]
       done;
@@ -688,14 +730,17 @@ let rec compile_constr reloc c sz cont =
 	let arity = List.length params in
 	let env_body = comp_env_cofix ndef arity rfv in
 	let lbl = Label.create () in
-	let cont1 =
-	  compile_constr env_body body (arity+1) (cont_cofix arity) in
-	let cont2 =
-	  add_grab (arity+1) lbl cont1 in
+        let comp arity =
+          (* 4 stack slots are needed to update the cofix when forced *)
+          set_max_stack_size (arity + 4);
+          compile_constr env_body body (arity+1) (cont_cofix arity)
+        in
+	let cont = ensure_stack_capacity comp arity in
 	lbl_bodies.(i) <- lbl;
-	fun_code := [Ksequence(cont2,!fun_code)];
+	fun_code := [Ksequence(add_grab (arity+1) lbl cont,!fun_code)];
       done;
       let fv = !rfv in
+      set_max_stack_size (sz + fv.size + ndef + 2);
       compile_fv reloc fv.fv_rev sz
 	(Kclosurecofix(fv.size, init, lbl_types, lbl_bodies) :: cont)
 
@@ -713,9 +758,11 @@ let rec compile_constr reloc c sz cont =
       let lbl_eblocks = Array.make neblock Label.no in 
       let branch1,cont = make_branch cont in
       (* Compiling return type *)
-      let lbl_typ,fcode =
-	label_code (compile_constr reloc t sz [Kpop sz; Kstop])
-      in fun_code := [Ksequence(fcode,!fun_code)];
+      let fcode =
+        ensure_stack_capacity (compile_constr reloc t sz) [Kpop sz; Kstop]
+      in
+      let lbl_typ,fcode = label_code fcode in
+      fun_code := [Ksequence(fcode,!fun_code)];
       (* Compiling branches *)
       let lbl_sw = Label.create () in
       let sz_b,branch,is_tailcall =
@@ -725,14 +772,9 @@ let rec compile_constr reloc c sz cont =
 	  sz, branch1, true
 	| _ -> sz+3, Kjump, false
       in
-      let annot = {ci = ci; rtbl = tbl; tailcall = is_tailcall} in
-     (* Compiling branch for accumulators *)
-      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
-      (* perform the extra match if needed (to many block constructors) *)
+
+      let c = ref cont in
+      (* Perform the extra match if needed (too many block constructors) *)
       if neblock <> 0 then begin
         let lbl_b, code_b = 
           label_code (
@@ -762,14 +804,34 @@ let rec compile_constr reloc c sz cont =
 	      compile_constr reloc branchs.(i) (sz_b+arity)
 		(Kappterm(arity,sz_appterm) :: !c) in
           let code_b = 
-            if tag < last_variant_tag then Kpushfields arity :: code_b
-            else Kacc 0::Kpop 1::Kpushfields(arity+1)::Kpop 1::code_b in
+            if tag < last_variant_tag then begin
+                set_max_stack_size (sz_b + arity);
+                Kpushfields arity :: code_b
+              end
+            else begin
+                set_max_stack_size (sz_b + arity + 1);
+                Kacc 0::Kpop 1::Kpushfields(arity+1)::Kpop 1::code_b
+              end
+          in
           let lbl_b,code_b = label_code code_b in
           if tag < last_variant_tag then lbl_blocks.(tag) <- lbl_b
           else lbl_eblocks.(tag - last_variant_tag) <- lbl_b;
 	  c := code_b
       done;
-      c := Klabel lbl_sw :: Kswitch(lbl_consts,lbl_blocks) :: !c;
+
+      let annot =
+        {ci = ci; rtbl = tbl; tailcall = is_tailcall;
+         max_stack_size = !max_stack_size - sz}
+      in
+
+     (* Compiling branch for accumulators *)
+      let lbl_accu, code_accu =
+        set_max_stack_size (sz+3);
+	label_code(Kmakeswitchblock(lbl_typ,lbl_sw,annot,sz) :: branch :: !c)
+      in
+      lbl_blocks.(0) <- lbl_accu;
+
+      c := Klabel lbl_sw :: Kswitch(lbl_consts,lbl_blocks) :: code_accu;
       let code_sw =
  	match branch1 with
         (* spiwack : branch1 can't be a lbl anymore it's a Branch instead
@@ -786,12 +848,14 @@ let rec compile_constr reloc c sz cont =
 	code_sw)
 
 and compile_str_cst reloc sc sz cont =
+  set_max_stack_size sz;
   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 (code_makeblock nargs tag cont)
+      let arity = Array.length args in
+      let cont = code_makeblock ~stack_size:(sz+arity-1) ~arity ~tag cont in
+      comp_args compile_str_cst reloc args sz cont
   | Bconstruct_app(tag,nparams,arity,args) ->
       if Int.equal (Array.length args) 0 then
         code_construct tag nparams arity cont
@@ -805,6 +869,7 @@ and compile_str_cst reloc sc sz cont =
 (* spiwack : compilation of constants with their arguments.
    Makes a special treatment with 31-bit integer addition *)
 and compile_get_global reloc (kn,u) sz cont =
+  set_max_stack_size sz;
   let kn = get_alias !global_env kn in
   if Univ.Instance.is_empty u then
     Kgetglobal kn :: cont
@@ -813,11 +878,13 @@ and compile_get_global reloc (kn,u) sz cont =
       compile_universe reloc () (Univ.Instance.to_array u) sz cont
 
 and compile_universe reloc uni sz cont =
+  set_max_stack_size sz;
   match Univ.Level.var_index uni with
   | None -> Kconst (Const_univ_level uni) :: cont
   | Some idx -> pos_universe_var idx reloc sz :: cont
 
 and compile_const reloc kn u args sz cont =
+  set_max_stack_size sz;
   let nargs = Array.length args in
   (* spiwack: checks if there is a specific way to compile the constant
               if there is not, Not_found is raised, and the function
@@ -879,7 +946,7 @@ let compile fail_on_error ?universes:(universes=0) env c =
     let reloc, init_code =
       if Int.equal universes 0 then
         let reloc = empty_comp_env () in
-        reloc, compile_constr reloc c 0 cont
+        reloc, ensure_stack_capacity (compile_constr reloc c 0) cont
       else
         (* We are going to generate a lambda, but merge the universe closure
          * with the function closure if it exists.
@@ -896,18 +963,24 @@ let compile fail_on_error ?universes:(universes=0) env c =
         let r_fun = comp_env_fun ~univs:universes arity in
         let lbl_fun = Label.create () in
         let cont_fun =
-          compile_constr r_fun body full_arity [Kreturn full_arity]
+          ensure_stack_capacity (compile_constr r_fun body full_arity)
+                         [Kreturn full_arity]
         in
         fun_code := [Ksequence(add_grab full_arity lbl_fun cont_fun,!fun_code)];
         let fv = fv r_fun in
-        reloc, compile_fv reloc fv.fv_rev 0 (Kclosure(lbl_fun,fv.size) :: cont)
+        let init_code =
+          ensure_stack_capacity (compile_fv reloc fv.fv_rev 0)
+                         (Kclosure(lbl_fun,fv.size) :: cont)
+        in
+        reloc, init_code
     in
     let fv = List.rev (!(reloc.in_env).fv_rev) in
     (if !Flags.dump_bytecode then
       Feedback.msg_debug (dump_bytecodes init_code !fun_code fv)) ;
     Some (init_code,!fun_code, Array.of_list fv)
   with TooLargeInductive tname ->
-    let fn = if fail_on_error then Errors.errorlabstrm "compile" else Feedback.msg_warning in
+    let fn = if fail_on_error then CErrors.user_err ?loc:None ~hdr:"compile" else
+	       (fun x -> Feedback.msg_warning x) in
       (Pp.(fn
 	   (str "Cannot compile code for virtual machine as it uses inductive " ++
 	    Id.print tname ++ str str_max_constructors));
diff --git a/kernel/cemitcodes.ml b/kernel/cemitcodes.ml
index d779a81ff..ad7a41a34 100644
--- a/kernel/cemitcodes.ml
+++ b/kernel/cemitcodes.ml
@@ -234,6 +234,7 @@ let emit_instr = function
       else (out opSETFIELD;out_int n)
   | Ksequence _ -> invalid_arg "Cemitcodes.emit_instr"
   | Kproj (n,p) -> out opPROJ; out_int n; slot_for_const (Const_proj p)
+  | Kensurestackcapacity size -> out opENSURESTACKCAPACITY; out_int size
   (* spiwack *)
   | Kbranch lbl -> out opBRANCH; out_label lbl
   | Kaddint31 -> out opADDINT31
diff --git a/kernel/constr.mli b/kernel/constr.mli
index f76b5ae4f..7095dbe6f 100644
--- a/kernel/constr.mli
+++ b/kernel/constr.mli
@@ -6,6 +6,9 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
+(** This file defines the most important datatype of Coq, namely kernel terms,
+    as well as a handful of generic manipulation functions. *)
+
 open Names
 
 (** {6 Value under universe substitution } *)
@@ -186,8 +189,12 @@ type ('constr, 'types) pcofixpoint =
     int * ('constr, 'types) prec_declaration
 
 type ('constr, 'types) kind_of_term =
-  | Rel       of int
-  | Var       of Id.t
+  | Rel       of int                                  (** Gallina-variable introduced by [forall], [fun], [let-in], [fix], or [cofix]. *)
+
+  | Var       of Id.t                                 (** Gallina-variable that was introduced by Vernacular-command that extends
+                                                          the local context of the currently open section
+                                                          (i.e. [Variable] or [Let]). *)
+
   | Meta      of metavariable
   | Evar      of 'constr pexistential
   | Sort      of Sorts.t
@@ -196,12 +203,16 @@ type ('constr, 'types) kind_of_term =
   | Lambda    of Name.t * 'types * 'constr            (** Concrete syntax ["fun A:B => C"] is represented as [Lambda (A,B,C)].  *)
   | LetIn     of Name.t * 'constr * 'types * 'constr  (** Concrete syntax ["let A:B := C in D"] is represented as [LetIn (A,B,C,D)]. *)
   | App       of 'constr * 'constr array              (** Concrete syntax ["(F P1 P2 ...  Pn)"] is represented as [App (F, [|P1; P2; ...; Pn|])].
+
                                                           The {!mkApp} constructor also enforces the following invariant:
                                                           - [F] itself is not {!App}
                                                           - and [[|P1;..;Pn|]] is not empty. *)
-  | Const     of constant puniverses
-  | Ind       of inductive puniverses
-  | Construct of constructor puniverses
+
+  | Const     of constant puniverses                  (** Gallina-variable that was introduced by Vernacular-command that extends the global environment
+                                                          (i.e. [Parameter], or [Axiom], or [Definition], or [Theorem] etc.) *)
+
+  | Ind       of inductive puniverses                 (** A name of an inductive type defined by [Variant], [Inductive] or [Record] Vernacular-commands. *)
+  | Construct of constructor puniverses               (** A constructor of an inductive type defined by [Variant], [Inductive] or [Record] Vernacular-commands. *)
   | Case      of case_info * 'constr * 'constr * 'constr array
   | Fix       of ('constr, 'types) pfixpoint
   | CoFix     of ('constr, 'types) pcofixpoint
diff --git a/kernel/context.ml b/kernel/context.ml
index 4e53b73a2..ae0388003 100644
--- a/kernel/context.ml
+++ b/kernel/context.ml
@@ -138,7 +138,7 @@ struct
       | LocalDef (_,v,ty) -> f v; f ty
 
     (** Reduce all terms in a given declaration to a single value. *)
-    let fold f decl acc =
+    let fold_constr f decl acc =
       match decl with
       | LocalAssum (n,ty) -> f ty acc
       | LocalDef (n,v,ty) -> f ty (f v acc)
@@ -147,9 +147,6 @@ struct
       | LocalAssum (na, ty) -> na, None, ty
       | LocalDef (na, v, ty) -> na, Some v, ty
 
-    let of_tuple = function
-      | n, None, ty -> LocalAssum (n,ty)
-      | n, Some v, ty -> LocalDef (n,v,ty)
   end
 
   (** Rel-context is represented as a list of declarations.
@@ -336,7 +333,7 @@ struct
       | LocalDef (_, v, ty) -> f v; f ty
 
     (** Reduce all terms in a given declaration to a single value. *)
-    let fold f decl a =
+    let fold_constr f decl a =
       match decl with
       | LocalAssum (_, ty) -> f ty a
       | LocalDef (_, v, ty) -> a |> f v |> f ty
@@ -348,6 +345,18 @@ struct
     let of_tuple = function
       | id, None, ty -> LocalAssum (id, ty)
       | id, Some v, ty -> LocalDef (id, v, ty)
+
+    let of_rel_decl f = function
+      | Rel.Declaration.LocalAssum (na,t) ->
+          LocalAssum (f na, t)
+      | Rel.Declaration.LocalDef (na,v,t) ->
+          LocalDef (f na, v, t)
+            
+    let to_rel_decl = function
+      | LocalAssum (id,t) ->
+          Rel.Declaration.LocalAssum (Name id, t)
+      | LocalDef (id,v,t) ->
+          Rel.Declaration.LocalDef (Name id,v,t)
   end
 
   (** Named-context is represented as a list of declarations.
@@ -401,23 +410,39 @@ struct
       | _ -> None
     in
     List.map_filter filter
-  end
+end
 
-module NamedList =
+module Compacted =
   struct
     module Declaration =
       struct
-        type t = Id.t list * Constr.t option * Constr.t
-
-        let map_constr f (ids, copt, ty as decl) =
-          let copt' = Option.map f copt in
-          let ty' = f ty in
-          if copt == copt' && ty == ty' then decl else (ids, copt', ty')
+        type t =
+          | LocalAssum of Id.t list * Constr.t
+          | LocalDef of Id.t list * Constr.t * Constr.t
+
+        let map_constr f = function
+          | LocalAssum (ids, ty) as decl ->
+             let ty' = f ty in
+             if ty == ty' then decl else LocalAssum (ids, ty')
+          | LocalDef (ids, c, ty) as decl ->
+             let ty' = f ty in
+             let c' = f c in
+             if c == c' && ty == ty' then decl else LocalDef (ids,c',ty')
+
+        let of_named_decl = function
+          | Named.Declaration.LocalAssum (id,t) ->
+              LocalAssum ([id],t)
+          | Named.Declaration.LocalDef (id,v,t) ->
+              LocalDef ([id],v,t)
+
+        let to_named_context = function
+          | LocalAssum (ids, t) ->
+             List.map (fun id -> Named.Declaration.LocalAssum (id,t)) ids
+          | LocalDef (ids, v, t) ->
+             List.map (fun id -> Named.Declaration.LocalDef (id,v,t)) ids
       end
 
     type t = Declaration.t list
 
     let fold f l ~init = List.fold_right f l init
   end
-
-type section_context = Named.t
diff --git a/kernel/context.mli b/kernel/context.mli
index b5f3904d2..955e214cb 100644
--- a/kernel/context.mli
+++ b/kernel/context.mli
@@ -79,10 +79,9 @@ sig
     val iter_constr : (Constr.t -> unit) -> t -> unit
 
     (** Reduce all terms in a given declaration to a single value. *)
-    val fold : (Constr.t -> 'a -> 'a) -> t -> 'a -> 'a
+    val fold_constr : (Constr.t -> 'a -> 'a) -> t -> 'a -> 'a
 
     val to_tuple : t -> Name.t * Constr.t option * Constr.t
-    val of_tuple : Name.t * Constr.t option * Constr.t -> t
   end
 
   (** Rel-context is represented as a list of declarations.
@@ -193,10 +192,18 @@ sig
     val iter_constr : (Constr.t -> unit) -> t -> unit
 
     (** Reduce all terms in a given declaration to a single value. *)
-    val fold : (Constr.t -> 'a -> 'a) -> t -> 'a -> 'a
+    val fold_constr : (Constr.t -> 'a -> 'a) -> t -> 'a -> 'a
 
     val to_tuple : t -> Id.t * Constr.t option * Constr.t
     val of_tuple : Id.t * Constr.t option * Constr.t -> t
+
+    (** Convert [Rel.Declaration.t] value to the corresponding [Named.Declaration.t] value.
+        The function provided as the first parameter determines how to translate "names" to "ids". *)
+    val of_rel_decl : (Name.t -> Id.t) -> Rel.Declaration.t -> t
+
+    (** Convert [Named.Declaration.t] value to the corresponding [Rel.Declaration.t] value. *)
+    (* TODO: Move this function to [Rel.Declaration] module and rename it to [of_named]. *)
+    val to_rel_decl : t -> Rel.Declaration.t
   end
 
   (** Rel-context is represented as a list of declarations.
@@ -244,17 +251,20 @@ sig
   val to_instance : t -> Constr.t list
 end
 
-module NamedList :
+module Compacted :
 sig
   module Declaration :
   sig
-    type t = Id.t list * Constr.t option * Constr.t
+    type t =
+      | LocalAssum of Id.t list * Constr.t
+      | LocalDef of Id.t list * Constr.t * Constr.t
+
     val map_constr : (Constr.t -> Constr.t) -> t -> t
+    val of_named_decl : Named.Declaration.t -> t
+    val to_named_context : t -> Named.t
   end
 
   type t = Declaration.t list
 
   val fold : (Declaration.t -> 'a -> 'a) -> t -> init:'a -> 'a
 end
-
-type section_context = Named.t
diff --git a/kernel/conv_oracle.ml b/kernel/conv_oracle.ml
index 462413bd3..3f1cf9248 100644
--- a/kernel/conv_oracle.ml
+++ b/kernel/conv_oracle.ml
@@ -71,7 +71,7 @@ let set_strategy ({ var_opacity; cst_opacity } as oracle) k l =
     | _ -> Cpred.add c oracle.cst_trstate
     in
     { oracle with cst_opacity; cst_trstate; }
-  | RelKey _ -> Errors.error "set_strategy: RelKey"
+  | RelKey _ -> CErrors.error "set_strategy: RelKey"
 
 let fold_strategy f { var_opacity; cst_opacity; } accu =
   let fvar id lvl accu = f (VarKey id) lvl accu in
diff --git a/kernel/cooking.ml b/kernel/cooking.ml
index 6dc2a617d..f5059cd75 100644
--- a/kernel/cooking.ml
+++ b/kernel/cooking.ml
@@ -13,7 +13,7 @@
 (* This module implements kernel-level discharching of local
    declarations over global constants and inductive types *)
 
-open Errors
+open CErrors
 open Util
 open Names
 open Term
@@ -21,6 +21,8 @@ open Declarations
 open Environ
 open Univ
 
+module NamedDecl = Context.Named.Declaration
+
 (*s Cooking the constants. *)
 
 let pop_dirpath p = match DirPath.repr p with
@@ -152,7 +154,7 @@ type inline = bool
 type result =
   constant_def * constant_type * projection_body option * 
     bool * constant_universes * inline
-    * Context.section_context option
+    * Context.Named.t option
 
 let on_body ml hy f = function
   | Undef _ as x -> x
@@ -202,8 +204,7 @@ let cook_constant env { from = cb; info } =
   in
   let const_hyps =
     Context.Named.fold_outside (fun decl hyps ->
-      let open Context.Named.Declaration in
-      List.filter (fun decl' -> not (Id.equal (get_id decl) (get_id decl')))
+      List.filter (fun decl' -> not (Id.equal (NamedDecl.get_id decl) (NamedDecl.get_id decl')))
 		  hyps)
       hyps ~init:cb.const_hyps in
   let typ = match cb.const_type with
diff --git a/kernel/cooking.mli b/kernel/cooking.mli
index 327e697d2..eb4073096 100644
--- a/kernel/cooking.mli
+++ b/kernel/cooking.mli
@@ -19,7 +19,7 @@ type inline = bool
 type result =
   constant_def * constant_type * projection_body option * 
     bool * constant_universes * inline
-    * Context.section_context option
+    * Context.Named.t option
 
 val cook_constant : env -> recipe -> result
 val cook_constr : Opaqueproof.cooking_info -> Term.constr -> Term.constr
diff --git a/kernel/csymtable.ml b/kernel/csymtable.ml
index 047da682a..40595f944 100644
--- a/kernel/csymtable.ml
+++ b/kernel/csymtable.ml
@@ -22,6 +22,8 @@ open Declarations
 open Pre_env
 open Cbytegen
 
+module NamedDecl = Context.Named.Declaration
+module RelDecl = Context.Rel.Declaration
 
 external tcode_of_code : emitcodes -> int -> tcode = "coq_tcode_of_code"
 external eval_tcode : tcode -> values array -> values = "coq_eval_tcode"
@@ -189,18 +191,14 @@ and slot_for_fv env fv =
       let nv = Pre_env.lookup_named_val id env in
       begin match force_lazy_val nv with
       | None ->
-         let open Context.Named in
-         let open Declaration in
-	 env.env_named_context |> lookup id |> get_value |> fill_fv_cache nv id val_of_named idfun
+	 env |> Pre_env.lookup_named id |> NamedDecl.get_value |> fill_fv_cache nv id val_of_named idfun
       | Some (v, _) -> v
       end
   | FVrel i ->
       let rv = Pre_env.lookup_rel_val i env in
       begin match force_lazy_val rv with
       | None ->
-         let open Context.Rel in
-         let open Declaration in
-	 env.env_rel_context |> lookup i |> get_value |> fill_fv_cache rv i val_of_rel env_of_rel
+	 env.env_rel_context |> Context.Rel.lookup i |> RelDecl.get_value |> fill_fv_cache rv i val_of_rel env_of_rel
       | Some (v, _) -> v
       end
   | FVuniv_var idu ->
@@ -219,17 +217,9 @@ and eval_to_patch env (buff,pl,fv) =
   eval_tcode tc vm_env
 
 and val_of_constr env c =
-  let (_,fun_code,_ as ccfv) =
-    try match compile true env c with
-	| Some v -> v
-	| None -> assert false
-    with reraise ->
-      let reraise = Errors.push reraise in
-      let () = print_string "can not compile \n" in
-      let () = Format.print_flush () in
-      iraise reraise
-  in
-  eval_to_patch env (to_memory ccfv)
+  match compile true env c with
+  | Some v -> eval_to_patch env (to_memory v)
+  | None -> assert false
 
 let set_transparent_const kn = () (* !?! *)
 let set_opaque_const kn = () (* !?! *)
diff --git a/kernel/declarations.mli b/kernel/declarations.mli
index 1b77d5b7c..7821ea20f 100644
--- a/kernel/declarations.mli
+++ b/kernel/declarations.mli
@@ -14,9 +14,8 @@ open Term
    inductive definitions, modules and module types *)
 
 type set_predicativity = ImpredicativeSet | PredicativeSet
-type type_hierarchy = TypeInType | StratifiedType
 
-type engagement = set_predicativity * type_hierarchy
+type engagement = set_predicativity
 
 (** {6 Representation of constants (Definition/Axiom) } *)
 
@@ -59,24 +58,39 @@ type projection_body = {
   proj_body : constr; (* For compatibility with VMs only, the match version *)
 }
 
+(* Global declarations (i.e. constants) can be either: *)
 type constant_def =
-  | Undef of inline
-  | Def of constr Mod_subst.substituted
-  | OpaqueDef of Opaqueproof.opaque
+  | Undef of inline                       (** a global assumption *)
+  | Def of constr Mod_subst.substituted   (** or a transparent global definition *)
+  | OpaqueDef of Opaqueproof.opaque       (** or an opaque global definition *)
 
 type constant_universes = Univ.universe_context
 
+(** The [typing_flags] are instructions to the type-checker which
+    modify its behaviour. The typing flags used in the type-checking
+    of a constant are tracked in their {!constant_body} so that they
+    can be displayed to the user. *)
+type typing_flags = {
+  check_guarded : bool; (** If [false] then fixed points and co-fixed
+                            points are assumed to be total. *)
+  check_universes : bool; (** If [false] universe constraints are not checked *)
+}
+
 (* some contraints are in constant_constraints, some other may be in
  * the OpaueDef *)
 type constant_body = {
-    const_hyps : Context.section_context; (** New: younger hyp at top *)
+    const_hyps : Context.Named.t; (** New: younger hyp at top *)
     const_body : constant_def;
     const_type : constant_type;
     const_body_code : Cemitcodes.to_patch_substituted option;
     const_polymorphic : bool; (** Is it polymorphic or not *)
     const_universes : constant_universes;
     const_proj : projection_body option;
-    const_inline_code : bool }
+    const_inline_code : bool;
+    const_typing_flags : typing_flags; (** The typing options which
+                                           were used for
+                                           type-checking. *)
+}
 
 (** {6 Representation of mutual inductive types in the kernel } *)
 
@@ -164,7 +178,7 @@ type mutual_inductive_body = {
 
     mind_ntypes : int;  (** Number of types in the block *)
 
-    mind_hyps : Context.section_context;  (** Section hypotheses on which the block depends *)
+    mind_hyps : Context.Named.t;  (** Section hypotheses on which the block depends *)
 
     mind_nparams : int;  (** Number of expected parameters including non-uniform ones (i.e. length of mind_params_ctxt w/o let-in) *)
 
@@ -177,7 +191,8 @@ type mutual_inductive_body = {
     mind_universes : Univ.universe_context; (** Local universe variables and constraints *)
 
     mind_private : bool option; (** allow pattern-matching: Some true ok, Some false blocked *)
-  
+
+    mind_typing_flags : typing_flags; (** typing flags at the time of the inductive creation *)
 }
 
 (** {6 Module declarations } *)
diff --git a/kernel/declareops.ml b/kernel/declareops.ml
index a09a8b786..0a822d6fa 100644
--- a/kernel/declareops.ml
+++ b/kernel/declareops.ml
@@ -9,11 +9,17 @@
 open Declarations
 open Mod_subst
 open Util
-open Context.Rel.Declaration
+
+module RelDecl = Context.Rel.Declaration
 
 (** Operations concernings types in [Declarations] :
     [constant_body], [mutual_inductive_body], [module_body] ... *)
 
+let safe_flags = {
+  check_guarded = true;
+  check_universes = true;
+}
+
 (** {6 Arities } *)
 
 let subst_decl_arity f g sub ar = 
@@ -89,7 +95,7 @@ let is_opaque cb = match cb.const_body with
 (** {7 Constant substitutions } *)
 
 let subst_rel_declaration sub =
-  map_constr (subst_mps sub)
+  RelDecl.map_constr (subst_mps sub)
 
 let subst_rel_context sub = List.smartmap (subst_rel_declaration sub)
 
@@ -131,7 +137,8 @@ let subst_const_body sub cb =
           Option.map (Cemitcodes.subst_to_patch_subst sub) cb.const_body_code;
         const_polymorphic = cb.const_polymorphic;
         const_universes = cb.const_universes;
-        const_inline_code = cb.const_inline_code }
+        const_inline_code = cb.const_inline_code;
+        const_typing_flags = cb.const_typing_flags }
 
 (** {7 Hash-consing of constants } *)
 
@@ -140,7 +147,7 @@ let subst_const_body sub cb =
     themselves. But would it really bring substantial gains ? *)
 
 let hcons_rel_decl =
-  map_type Term.hcons_types % map_value Term.hcons_constr % map_name Names.Name.hcons
+  RelDecl.map_name Names.Name.hcons %> RelDecl.map_value Term.hcons_constr %> RelDecl.map_type Term.hcons_types
 
 let hcons_rel_context l = List.smartmap hcons_rel_decl l
 
@@ -254,7 +261,9 @@ let subst_mind_body sub mib =
     mind_packets = Array.smartmap (subst_mind_packet sub) mib.mind_packets ;
     mind_polymorphic = mib.mind_polymorphic;
     mind_universes = mib.mind_universes;
-    mind_private = mib.mind_private }
+    mind_private = mib.mind_private;
+    mind_typing_flags = mib.mind_typing_flags;
+  }
 
 let inductive_instance mib =
   if mib.mind_polymorphic then
diff --git a/kernel/declareops.mli b/kernel/declareops.mli
index ad2b5d0a6..6650b6b7b 100644
--- a/kernel/declareops.mli
+++ b/kernel/declareops.mli
@@ -69,6 +69,11 @@ val subst_mind_body : substitution -> mutual_inductive_body -> mutual_inductive_
 val inductive_instance : mutual_inductive_body -> universe_instance
 val inductive_context : mutual_inductive_body -> universe_context
 
+(** {6 Kernel flags} *)
+
+(** A default, safe set of flags for kernel type-checking *)
+val safe_flags : typing_flags
+
 (** {6 Hash-consing} *)
 
 (** Here, strictly speaking, we don't perform true hash-consing
diff --git a/kernel/entries.mli b/kernel/entries.mli
index d07ca2103..77081947e 100644
--- a/kernel/entries.mli
+++ b/kernel/entries.mli
@@ -51,7 +51,8 @@ type mutual_inductive_entry = {
   mind_entry_inds : one_inductive_entry list;
   mind_entry_polymorphic : bool; 
   mind_entry_universes : Univ.universe_context;
-  mind_entry_private : bool option }
+  mind_entry_private : bool option;
+}
 
 (** {6 Constants (Definition/Axiom) } *)
 type 'a proof_output = constr Univ.in_universe_context_set * 'a
@@ -60,7 +61,7 @@ type 'a const_entry_body = 'a proof_output Future.computation
 type 'a definition_entry = {
   const_entry_body   : 'a const_entry_body;
   (* List of section variables *)
-  const_entry_secctx : Context.section_context option;
+  const_entry_secctx : Context.Named.t option;
   (* State id on which the completion of type checking is reported *)
   const_entry_feedback : Stateid.t option;
   const_entry_type        : types option;
@@ -72,7 +73,7 @@ type 'a definition_entry = {
 type inline = int option (* inlining level, None for no inlining *)
 
 type parameter_entry = 
-    Context.section_context option * bool * types Univ.in_universe_context * inline 
+    Context.Named.t option * bool * types Univ.in_universe_context * inline 
 
 type projection_entry = {
   proj_entry_ind : mutual_inductive;
@@ -97,7 +98,12 @@ type module_entry =
   | MExpr of
       module_params_entry * module_struct_entry * module_struct_entry option
 
-type seff_env = [ `Nothing | `Opaque of Constr.t * Univ.universe_context_set ]
+
+type seff_env =
+  [ `Nothing
+  (* The proof term and its universes.
+     Same as the constant_body's but not in an ephemeron *)
+  | `Opaque of Constr.t * Univ.universe_context_set ]
 
 type side_eff =
   | SEsubproof of constant * Declarations.constant_body * seff_env
diff --git a/kernel/environ.ml b/kernel/environ.ml
index d8493d9ba..4a543f195 100644
--- a/kernel/environ.ml
+++ b/kernel/environ.ml
@@ -20,7 +20,7 @@
 (* This file defines the type of environments on which the
    type-checker works, together with simple related functions *)
 
-open Errors
+open CErrors
 open Util
 open Names
 open Term
@@ -45,26 +45,25 @@ let empty_named_context_val = empty_named_context_val
 let empty_env = empty_env
 
 let engagement env = env.env_stratification.env_engagement
+let typing_flags env = env.env_typing_flags
 
 let is_impredicative_set env = 
-  match fst (engagement env) with
+  match engagement env with
   | ImpredicativeSet -> true
   | _ -> false
 
-let type_in_type env =
-  match snd (engagement env) with
-  | TypeInType -> true
-  | _ -> false
+let type_in_type env = not (typing_flags env).check_universes
+let deactivated_guard env = not (typing_flags env).check_guarded
 
 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 named_context env = env.env_named_context.env_named_ctx
+let named_context_val env = env.env_named_context
 let rel_context env = env.env_rel_context
 let opaque_tables env = env.indirect_pterms
 let set_opaque_tables env indirect_pterms = { env with indirect_pterms }
 
 let empty_context env =
-  match env.env_rel_context, env.env_named_context with
+  match env.env_rel_context, env.env_named_context.env_named_ctx with
   | [], [] -> true
   | _ -> false
 
@@ -100,14 +99,12 @@ let fold_rel_context f env ~init =
 
 (* Named context *)
 
-let named_context_of_val = fst
-let named_vals_of_val = snd
+let named_context_of_val c = c.env_named_ctx
 
 (* [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 =
-  on_fst (Context.Named.map f)
+let map_named_val = map_named_val
 
 let empty_named_context = Context.Named.empty
 
@@ -119,8 +116,8 @@ let val_of_named_context ctxt =
   List.fold_right push_named_context_val ctxt empty_named_context_val
 
 
-let lookup_named id env = Context.Named.lookup id env.env_named_context
-let lookup_named_val id (ctxt,_) = Context.Named.lookup id ctxt
+let lookup_named = lookup_named
+let lookup_named_val id ctxt = fst (Id.Map.find id ctxt.env_named_map)
 
 let eq_named_context_val c1 c2 =
    c1 == c2 || Context.Named.equal (named_context_of_val c1) (named_context_of_val c2)
@@ -140,10 +137,9 @@ let evaluable_named id env =
   | Some _      -> true
   | _          -> false
 
-let reset_with_named_context (ctxt,ctxtv) env =
+let reset_with_named_context ctxt env =
   { env with
     env_named_context = ctxt;
-    env_named_vals = ctxtv;
     env_rel_context = Context.Rel.empty;
     env_rel_val = [];
     env_nb_rel = 0 }
@@ -158,11 +154,11 @@ let pop_rel_context n env =
 
 let fold_named_context f env ~init =
   let rec fold_right env =
-    match env.env_named_context with
-    | [] -> init
-    | d::ctxt ->
+    match match_named_context_val env.env_named_context with
+    | None -> init
+    | Some (d, v, rem) ->
 	let env =
-	  reset_with_named_context (ctxt,List.tl env.env_named_vals) env in
+	  reset_with_named_context rem env in
 	f env d (fold_right env)
   in fold_right env
 
@@ -211,6 +207,9 @@ let set_engagement c env = (* Unsafe *)
   { env with env_stratification =
     { env.env_stratification with env_engagement = c } }
 
+let set_typing_flags c env = (* Unsafe *)
+  { env with env_typing_flags = c }
+
 (* Global constants *)
 
 let lookup_constant = lookup_constant
@@ -328,6 +327,9 @@ let polymorphic_pconstant (cst,u) env =
   if Univ.Instance.is_empty u then false
   else polymorphic_constant cst env
 
+let type_in_type_constant cst env =
+  not (lookup_constant cst env).const_typing_flags.check_universes
+
 let template_polymorphic_constant cst env =
   match (lookup_constant cst env).const_type with 
   | TemplateArity _ -> true
@@ -357,6 +359,9 @@ let polymorphic_pind (ind,u) env =
   if Univ.Instance.is_empty u then false
   else polymorphic_ind ind env
 
+let type_in_type_ind (mind,i) env =
+  not (lookup_mind mind env).mind_typing_flags.check_universes
+
 let template_polymorphic_ind (mind,i) env =
   match (lookup_mind mind env).mind_packets.(i).mind_arity with 
   | TemplateArity _ -> true
@@ -408,7 +413,7 @@ let global_vars_set env constr =
 	  Id.Set.union (vars_of_global env c) acc
       | _ ->
 	  acc in
-    fold_constr filtrec acc c
+    Term.fold_constr filtrec acc c
   in
     filtrec Id.Set.empty constr
 
@@ -485,65 +490,35 @@ let compile_constant_body = Cbytegen.compile_constant_body false
 
 exception Hyp_not_found
 
-let apply_to_hyp (ctxt,vals) id f =
-  let rec aux rtail ctxt vals =
-    match ctxt, vals with
-    | d::ctxt, v::vals ->
-	if Id.equal (get_id d) 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 apply_to_hyp_and_dependent_on (ctxt,vals) id f g =
-  let rec aux ctxt vals =
-    match ctxt,vals with
-    | d::ctxt, v::vals ->
+let apply_to_hyp ctxt id f =
+  let rec aux rtail ctxt =
+    match match_named_context_val ctxt with
+    | Some (d, v, ctxt) ->
 	if Id.equal (get_id d) id then
-	  let sign = ctxt,vals in
-	  push_named_context_val (f d sign) sign
+          push_named_context_val_val (f ctxt.env_named_ctx d rtail) v ctxt
 	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
-    | decl::ctxt', v::vals' ->
-	if Id.equal (get_id decl) 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
-
+	  let ctxt' = aux (d::rtail) ctxt in
+	  push_named_context_val_val d v ctxt'
+    | None -> raise Hyp_not_found
+  in aux [] ctxt
 
 (* To be used in Logic.clear_hyps *)
-let remove_hyps ids check_context check_value (ctxt, vals) =
-  let rec remove_hyps ctxt vals = match ctxt, vals with
-  | [], [] -> [], []
-  | d :: rctxt, (nid, v) :: rvals ->
-    let ans = remove_hyps rctxt rvals in
-    if Id.Set.mem (get_id d) ids then ans
+let remove_hyps ids check_context check_value ctxt =
+  let rec remove_hyps ctxt = match match_named_context_val ctxt with
+  | None -> empty_named_context_val, false
+  | Some (d, v, rctxt) ->
+    let (ans, seen) = remove_hyps rctxt in
+    if Id.Set.mem (get_id d) ids then (ans, true)
+    else if not seen then ctxt, false
     else
-      let (rctxt', rvals') = ans in
+      let rctxt' = ans in
       let d' = check_context d in
       let v' = check_value v in
-      if d == d' && v == v' && rctxt == rctxt' && rvals == rvals' then
-        ctxt, vals
-      else (d' :: rctxt', (nid, v') :: rvals')
-  | _ -> assert false
+      if d == d' && v == v' && rctxt == rctxt' then
+        ctxt, true
+      else push_named_context_val_val d' v' rctxt', true
   in
-  remove_hyps ctxt vals
+  fst (remove_hyps ctxt)
 
 (*spiwack: the following functions assemble the pieces of the retroknowledge
    note that the "consistent" register function is available in the module
diff --git a/kernel/environ.mli b/kernel/environ.mli
index 520389954..ea570cb4a 100644
--- a/kernel/environ.mli
+++ b/kernel/environ.mli
@@ -50,8 +50,10 @@ val set_opaque_tables : env -> Opaqueproof.opaquetab -> env
 
 
 val engagement    : env -> engagement
+val typing_flags    : env -> typing_flags
 val is_impredicative_set : env -> bool
 val type_in_type : env -> bool
+val deactivated_guard : env -> bool
 
 (** is the local context empty *)
 val empty_context : env -> bool
@@ -76,7 +78,6 @@ val fold_rel_context :
 (** {5 Context of variables (section variables and goal assumptions) } *)
 
 val named_context_of_val : named_context_val -> Context.Named.t
-val named_vals_of_val : named_context_val -> Pre_env.named_vals
 val val_of_named_context : Context.Named.t -> named_context_val
 val empty_named_context_val : named_context_val
 
@@ -136,6 +137,7 @@ val evaluable_constant : constant -> env -> bool
 (** New-style polymorphism *)
 val polymorphic_constant  : constant -> env -> bool
 val polymorphic_pconstant : pconstant -> env -> bool
+val type_in_type_constant : constant -> env -> bool
 
 (** Old-style polymorphism *)
 val template_polymorphic_constant  : constant -> env -> bool
@@ -183,6 +185,7 @@ val lookup_mind : mutual_inductive -> env -> mutual_inductive_body
 (** New-style polymorphism *)
 val polymorphic_ind  : inductive -> env -> bool
 val polymorphic_pind : pinductive -> env -> bool
+val type_in_type_ind : inductive -> env -> bool
 
 (** Old-style polymorphism *)
 val template_polymorphic_ind : inductive -> env -> bool
@@ -212,6 +215,7 @@ val push_context_set : ?strict:bool -> Univ.universe_context_set -> env -> env
 val push_constraints_to_env : 'a Univ.constrained -> env -> env
 
 val set_engagement : engagement -> env -> env
+val set_typing_flags : typing_flags -> env -> env
 
 (** {6 Sets of referred section variables }
    [global_vars_set env c] returns the list of [id]'s occurring either
@@ -227,7 +231,7 @@ val vars_of_global : env -> constr -> Id.Set.t
 val really_needed : env -> Id.Set.t -> Id.Set.t
 
 (** like [really_needed] but computes a well ordered named context *)
-val keep_hyps : env -> Id.Set.t -> Context.section_context
+val keep_hyps : env -> Id.Set.t -> Context.Named.t
 
 (** {5 Unsafe judgments. }
     We introduce here the pre-type of judgments, which is
@@ -260,18 +264,6 @@ val apply_to_hyp : named_context_val -> variable ->
   (Context.Named.t -> Context.Named.Declaration.t -> Context.Named.t -> Context.Named.Declaration.t) ->
     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 ->
-  (Context.Named.Declaration.t -> named_context_val -> Context.Named.Declaration.t) ->
-    (Context.Named.Declaration.t -> named_context_val -> Context.Named.Declaration.t) ->
-      named_context_val
-
-val insert_after_hyp : named_context_val -> variable ->
-  Context.Named.Declaration.t ->
-    (Context.Named.t -> unit) -> named_context_val
-
 val remove_hyps : Id.Set.t -> (Context.Named.Declaration.t -> Context.Named.Declaration.t) -> (Pre_env.lazy_val -> Pre_env.lazy_val) -> named_context_val -> named_context_val
 
 
diff --git a/kernel/fast_typeops.ml b/kernel/fast_typeops.ml
deleted file mode 100644
index 7f4ba8ecb..000000000
--- a/kernel/fast_typeops.ml
+++ /dev/null
@@ -1,463 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-open Errors
-open Util
-open Names
-open Univ
-open Term
-open Vars
-open Declarations
-open Environ
-open Reduction
-open Inductive
-open Type_errors
-
-let conv_leq l2r env x y = default_conv CUMUL ~l2r env x y
-
-let conv_leq_vecti env v1 v2 =
-  Array.fold_left2_i
-    (fun i _ t1 t2 ->
-      try conv_leq false env t1 t2
-      with NotConvertible -> raise (NotConvertibleVect i))
-    ()
-    v1
-    v2
-
-let check_constraints cst env = 
-  if Environ.check_constraints cst env then ()
-  else error_unsatisfied_constraints env cst
-
-(* This should be a type (a priori without intention to be an assumption) *)
-let type_judgment env c t =
-  match kind_of_term(whd_betadeltaiota env t) with
-    | Sort s -> {utj_val = c; utj_type = s }
-    | _ -> error_not_type env (make_judge c t)
-
-let check_type env c t =
-  match kind_of_term(whd_betadeltaiota env t) with
-  | Sort s -> s
-  | _ -> error_not_type env (make_judge c t)
-
-(* This should be a type intended to be assumed. The error message is *)
-(* not as useful as for [type_judgment]. *)
-let assumption_of_judgment env t ty =
-  try let _ = check_type env t ty in t
-  with TypeError _ ->
-    error_assumption env (make_judge t ty)
-
-(************************************************)
-(* Incremental typing rules: builds a typing judgment given the *)
-(* judgments for the subterms. *)
-
-(*s Type of sorts *)
-
-(* Prop and Set *)
-
-let judge_of_prop = mkSort type1_sort
-
-let judge_of_prop_contents _ = judge_of_prop
-
-(* Type of Type(i). *)
-
-let judge_of_type u =
-  let uu = Universe.super u in
-    mkType uu
-
-(*s Type of a de Bruijn index. *)
-
-let judge_of_relative env n =
-  try
-    let open Context.Rel.Declaration in
-    env |> lookup_rel n |> get_type |> lift n
-  with Not_found ->
-    error_unbound_rel env n
-
-(* Type of variables *)
-let judge_of_variable env id =
-  try named_type id env
-  with Not_found ->
-    error_unbound_var env id
-
-(* Management of context of variables. *)
-
-(* Checks if a context of variables can be instantiated by the
-   variables of the current env *)
-(* TODO: check order? *)
-let check_hyps_inclusion env f c sign =
-  Context.Named.fold_outside
-    (fun decl () ->
-      let open Context.Named.Declaration in
-      let id = get_id decl in
-      let ty1 = get_type decl in
-      try
-        let ty2 = named_type id env in
-        if not (eq_constr ty2 ty1) then raise Exit
-      with Not_found | Exit ->
-        error_reference_variables env id (f c))
-    sign
-    ~init:()
-
-(* Instantiation of terms on real arguments. *)
-
-(* Make a type polymorphic if an arity *)
-
-(* Type of constants *)
-
-
-let type_of_constant_knowing_parameters_arity env t paramtyps =
-  match t with
-  | RegularArity t -> t
-  | TemplateArity (sign,ar) ->
-      let ctx = List.rev sign in
-      let ctx,s = instantiate_universes env ctx ar paramtyps in
-      mkArity (List.rev ctx,s)
-
-let type_of_constant_knowing_parameters env cst paramtyps =
-  let ty, cu = constant_type env cst in
-    type_of_constant_knowing_parameters_arity env ty paramtyps, cu
-
-let judge_of_constant_knowing_parameters env (kn,u as cst) args =
-  let cb = lookup_constant kn env in
-  let () = check_hyps_inclusion env mkConstU cst cb.const_hyps in
-  let ty, cu = type_of_constant_knowing_parameters env cst args in
-  let () = check_constraints cu env in
-    ty
-
-let judge_of_constant env cst =
-  judge_of_constant_knowing_parameters env cst [||]
-
-(* Type of a lambda-abstraction. *)
-
-(* [judge_of_abstraction env name var j] implements the rule
-
- env, name:typ |- j.uj_val:j.uj_type     env, |- (name:typ)j.uj_type : s
- -----------------------------------------------------------------------
-          env |- [name:typ]j.uj_val : (name:typ)j.uj_type
-
-  Since all products are defined in the Calculus of Inductive Constructions
-  and no upper constraint exists on the sort $s$, we don't need to compute $s$
-*)
-
-let judge_of_abstraction env name var ty =
-  mkProd (name, var, ty)
-
-(* Type of an application. *)
-
-let make_judgev c t = 
-  Array.map2 make_judge c t
-
-let judge_of_apply env func funt argsv argstv =
-  let len = Array.length argsv in
-  let rec apply_rec i typ = 
-    if Int.equal i len then typ
-    else 
-      (match kind_of_term (whd_betadeltaiota env typ) with
-      | Prod (_,c1,c2) ->
-	let arg = argsv.(i) and argt = argstv.(i) in
-	  (try
-	     let () = conv_leq false env argt c1 in
-	       apply_rec (i+1) (subst1 arg c2)
-	   with NotConvertible ->
-	     error_cant_apply_bad_type env
-	       (i+1,c1,argt)
-	       (make_judge func funt)
-	       (make_judgev argsv argstv))
-	    
-      | _ ->
-	error_cant_apply_not_functional env 
-	  (make_judge func funt)
-	  (make_judgev argsv argstv))
-  in apply_rec 0 funt
-
-(* Type of product *)
-
-let sort_of_product env domsort rangsort =
-  match (domsort, rangsort) with
-    (* Product rule (s,Prop,Prop) *)
-    | (_,       Prop Null)  -> rangsort
-    (* Product rule (Prop/Set,Set,Set) *)
-    | (Prop _,  Prop Pos) -> rangsort
-    (* Product rule (Type,Set,?) *)
-    | (Type u1, Prop Pos) ->
-        if is_impredicative_set env then
-          (* Rule is (Type,Set,Set) in the Set-impredicative calculus *)
-          rangsort
-        else
-          (* Rule is (Type_i,Set,Type_i) in the Set-predicative calculus *)
-          Type (Universe.sup Universe.type0 u1)
-    (* Product rule (Prop,Type_i,Type_i) *)
-    | (Prop Pos,  Type u2)  -> Type (Universe.sup Universe.type0 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 (Universe.sup u1 u2)
-
-(* [judge_of_product env name (typ1,s1) (typ2,s2)] implements the rule
-
-    env |- typ1:s1       env, name:typ1 |- typ2 : s2
-    -------------------------------------------------------------------------
-         s' >= (s1,s2), env |- (name:typ)j.uj_val : s'
-
-  where j.uj_type is convertible to a sort s2
-*)
-let judge_of_product env name s1 s2 =
-  let s = sort_of_product env s1 s2 in
-    mkSort s
-
-(* Type of a type cast *)
-
-(* [judge_of_cast env (c,typ1) (typ2,s)] implements the rule
-
-    env |- c:typ1    env |- typ2:s    env |- typ1 <= typ2
-    ---------------------------------------------------------------------
-         env |- c:typ2
-*)
-
-let judge_of_cast env c ct k expected_type =
-  try
-    match k with
-    | VMcast ->
-      vm_conv CUMUL env ct expected_type
-    | DEFAULTcast ->
-      default_conv ~l2r:false CUMUL env ct expected_type
-    | REVERTcast ->
-      default_conv ~l2r:true CUMUL env ct expected_type
-    | NATIVEcast ->
-      let sigma = Nativelambda.empty_evars in
-      Nativeconv.native_conv CUMUL sigma env ct expected_type
-  with NotConvertible ->
-    error_actual_type env (make_judge c ct) expected_type
-
-(* Inductive types. *)
-
-(* The type is parametric over the uniform parameters whose conclusion
-   is in Type; to enforce the internal constraints between the
-   parameters and the instances of Type occurring in the type of the
-   constructors, we use the level variables _statically_ assigned to
-   the conclusions of the parameters as mediators: e.g. if a parameter
-   has conclusion Type(alpha), static constraints of the form alpha<=v
-   exist between alpha and the Type's occurring in the constructor
-   types; when the parameters is finally instantiated by a term of
-   conclusion Type(u), then the constraints u<=alpha is computed in
-   the App case of execute; from this constraints, the expected
-   dynamic constraints of the form u<=v are enforced *)
-
-let judge_of_inductive_knowing_parameters env (ind,u as indu) args =
-  let (mib,mip) as spec = lookup_mind_specif env ind in
-  check_hyps_inclusion env mkIndU indu mib.mind_hyps;
-  let t,cst = Inductive.constrained_type_of_inductive_knowing_parameters 
-    env (spec,u) args
-  in
-    check_constraints cst env;
-    t
-
-let judge_of_inductive env (ind,u as indu) =
-  let (mib,mip) = lookup_mind_specif env ind in
-  check_hyps_inclusion env mkIndU indu mib.mind_hyps;
-  let t,cst = Inductive.constrained_type_of_inductive env ((mib,mip),u) in
-    check_constraints cst env;
-    t
-
-(* Constructors. *)
-
-let judge_of_constructor env (c,u as cu) =
-  let _ =
-    let ((kn,_),_) = c in
-    let mib = lookup_mind kn env in
-    check_hyps_inclusion env mkConstructU cu mib.mind_hyps in
-  let specif = lookup_mind_specif env (inductive_of_constructor c) in
-  let t,cst = constrained_type_of_constructor cu specif in
-  let () = check_constraints cst env in
-    t
-
-(* Case. *)
-
-let check_branch_types env (ind,u) c ct lft explft =
-  try conv_leq_vecti env lft explft
-  with
-      NotConvertibleVect i ->
-        error_ill_formed_branch env c ((ind,i+1),u) lft.(i) explft.(i)
-    | Invalid_argument _ ->
-        error_number_branches env (make_judge c ct) (Array.length explft)
-
-let judge_of_case env ci p pt c ct lf lft =
-  let (pind, _ as indspec) =
-    try find_rectype env ct
-    with Not_found -> error_case_not_inductive env (make_judge c ct) in
-  let _ = check_case_info env pind ci in
-  let (bty,rslty) =
-    type_case_branches env indspec (make_judge p pt) c in
-  let () = check_branch_types env pind c ct lft bty in
-    rslty
-
-let judge_of_projection env p c ct =
-  let pb = lookup_projection p env in
-  let (ind,u), args =
-    try find_rectype env ct
-    with Not_found -> error_case_not_inductive env (make_judge c ct)
-  in
-    assert(eq_mind pb.proj_ind (fst ind));
-    let ty = Vars.subst_instance_constr u pb.Declarations.proj_type in
-      substl (c :: List.rev args) ty
-      
-
-(* Fixpoints. *)
-
-(* Checks the type of a general (co)fixpoint, i.e. without checking *)
-(* the specific guard condition. *)
-
-let type_fixpoint env lna lar vdef vdeft =
-  let lt = Array.length vdeft in
-  assert (Int.equal (Array.length lar) lt);
-  try
-    conv_leq_vecti env vdeft (Array.map (fun ty -> lift lt ty) lar)
-  with NotConvertibleVect i ->
-    error_ill_typed_rec_body env i lna (make_judgev vdef vdeft) lar
-
-(************************************************************************)
-(************************************************************************)
-
-(* The typing machine. *)
-    (* ATTENTION : faudra faire le typage du contexte des Const,
-    Ind et Constructsi un jour cela devient des constructions
-    arbitraires et non plus des variables *)
-let rec execute env cstr =
-  let open Context.Rel.Declaration in
-  match kind_of_term cstr with
-    (* Atomic terms *)
-    | Sort (Prop c) ->
-      judge_of_prop_contents c
-	
-    | Sort (Type u) ->
-      judge_of_type u
-
-    | Rel n ->
-      judge_of_relative env n
-
-    | Var id ->
-      judge_of_variable env id
-
-    | Const c ->
-      judge_of_constant env c
-	
-    | Proj (p, c) ->
-        let ct = execute env c in
-          judge_of_projection env p c ct
-
-    (* Lambda calculus operators *)
-    | App (f,args) ->
-        let argst = execute_array env args in
-	let ft =
-	  match kind_of_term f with
-	  | Ind ind when Environ.template_polymorphic_pind ind env ->
-	      (* Template sort-polymorphism of inductive types *)
-	    let args = Array.map (fun t -> lazy t) argst in
-	      judge_of_inductive_knowing_parameters env ind args
-	  | Const cst when Environ.template_polymorphic_pconstant cst env ->
-	      (* Template sort-polymorphism of constants *)
-	    let args = Array.map (fun t -> lazy t) argst in
-	      judge_of_constant_knowing_parameters env cst args
-	  | _ ->
-	    (* Full or no sort-polymorphism *)
-	    execute env f
-	in
-
-	  judge_of_apply env f ft args argst
-
-    | Lambda (name,c1,c2) ->
-      let _ = execute_is_type env c1 in
-      let env1 = push_rel (LocalAssum (name,c1)) env in
-      let c2t = execute env1 c2 in
-        judge_of_abstraction env name c1 c2t
-
-    | Prod (name,c1,c2) ->
-      let vars = execute_is_type env c1 in
-      let env1 = push_rel (LocalAssum (name,c1)) env in
-      let vars' = execute_is_type env1 c2 in
-	judge_of_product env name vars vars'
-
-    | LetIn (name,c1,c2,c3) ->
-      let c1t = execute env c1 in
-      let _c2s = execute_is_type env c2 in
-      let _ = judge_of_cast env c1 c1t DEFAULTcast c2 in
-      let env1 = push_rel (LocalDef (name,c1,c2)) env in
-      let c3t = execute env1 c3 in
-	subst1 c1 c3t
-
-    | Cast (c,k,t) ->
-      let ct = execute env c in
-      let _ts = execute_type env t in
-      let _ = judge_of_cast env c ct k t in
-	t
-
-    (* Inductive types *)
-    | Ind ind ->
-      judge_of_inductive env ind
-
-    | Construct c ->
-      judge_of_constructor env c
-
-    | Case (ci,p,c,lf) ->
-        let ct = execute env c in
-        let pt = execute env p in
-        let lft = execute_array env lf in
-          judge_of_case env ci p pt c ct lf lft
-
-    | Fix ((vn,i as vni),recdef) ->
-      let (fix_ty,recdef') = execute_recdef env recdef i in
-      let fix = (vni,recdef') in
-        check_fix env fix; fix_ty
-	  
-    | CoFix (i,recdef) ->
-      let (fix_ty,recdef') = execute_recdef env recdef i in
-      let cofix = (i,recdef') in
-        check_cofix env cofix; fix_ty
-	  
-    (* Partial proofs: unsupported by the kernel *)
-    | Meta _ ->
-	anomaly (Pp.str "the kernel does not support metavariables")
-
-    | Evar _ ->
-	anomaly (Pp.str "the kernel does not support existential variables")
-
-and execute_is_type env constr =
-  let t = execute env constr in
-    check_type env constr t
-
-and execute_type env constr =
-  let t = execute env constr in
-    type_judgment env constr t
-
-and execute_recdef env (names,lar,vdef) i =
-  let lart = execute_array env lar in
-  let lara = Array.map2 (assumption_of_judgment env) lar lart in
-  let env1 = push_rec_types (names,lara,vdef) env in
-  let vdeft = execute_array env1 vdef in
-  let () = type_fixpoint env1 names lara vdef vdeft in
-    (lara.(i),(names,lara,vdef))
-
-and execute_array env = Array.map (execute env)
-
-(* Derived functions *)
-let infer env constr =
-  let t = execute env constr in
-    make_judge constr t
-
-let infer = 
-  if Flags.profile then
-    let infer_key = Profile.declare_profile "Fast_infer" in
-      Profile.profile2 infer_key infer
-  else infer
-
-let infer_type env constr =
-  execute_type env constr
-
-let infer_v env cv =
-  let jv = execute_array env cv in
-    make_judgev cv jv
diff --git a/kernel/indtypes.ml b/kernel/indtypes.ml
index edb758f07..de97268b3 100644
--- a/kernel/indtypes.ml
+++ b/kernel/indtypes.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-open Errors
+open CErrors
 open Util
 open Names
 open Univ
@@ -50,7 +50,7 @@ let is_indices_matter () = !indices_matter
 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
+   let t' = whd_all env t in
    if noccur_between x nvars t' then Some t'
    else None
 
@@ -129,7 +129,7 @@ let is_unit constrsinfos =
 
 let infos_and_sort env t =
   let rec aux env t max =
-    let t = whd_betadeltaiota env t in
+    let t = whd_all env t in
       match kind_of_term t with
       | Prod (name,c1,c2) ->
         let varj = infer_type env c1 in
@@ -409,7 +409,7 @@ let check_correct_par (env,n,ntypes,_) paramdecls ind_index args =
     | LocalDef _ :: paramdecls ->
       check param_index (paramdecl_index+1) paramdecls
     | _::paramdecls ->
-        match kind_of_term (whd_betadeltaiota env params.(param_index)) with
+        match kind_of_term (whd_all env params.(param_index)) with
 	  | Rel w when Int.equal w paramdecl_index ->
             check (param_index-1) (paramdecl_index+1) paramdecls
 	  | _ ->
@@ -436,7 +436,7 @@ if Int.equal nmr 0 then 0 else
 	| (_,[]) -> assert false (* |paramsctxt|>=nmr *)
 	| (lp, LocalDef _ :: paramsctxt) -> find k (index-1) (lp,paramsctxt)
 	| (p::lp,_::paramsctxt) ->
-       ( match kind_of_term (whd_betadeltaiota env p) with
+       ( match kind_of_term (whd_all env p) with
 	  | Rel w when Int.equal w index -> find (k+1) (index-1) (lp,paramsctxt)
           | _ -> k)
   in find 0 (n-1) (lpar,List.rev paramsctxt)
@@ -466,7 +466,7 @@ let ienv_push_inductive (env, n, ntypes, ra_env) ((mi,u),lrecparams) =
 
 let rec ienv_decompose_prod (env,_,_,_ as ienv) n c =
   if Int.equal n 0 then (ienv,c) else
-    let c' = whd_betadeltaiota env c in
+    let c' = whd_all env c in
     match kind_of_term c' with
 	Prod(na,a,b) ->
 	  let ienv' = ienv_push_var ienv (na,a,mk_norec) in
@@ -483,15 +483,19 @@ let array_min nmr a = if Int.equal nmr 0 then 0 else
     for use by the guard condition (terms at these positions are
     considered sub-terms) as well as the number of of non-uniform
     arguments (used to generate induction schemes, so a priori less
-    relevant to the kernel). *)
-let check_positivity_one recursive (env,_,ntypes,_ as ienv) paramsctxt (_,i as ind) nnonrecargs lcnames indlc =
+    relevant to the kernel).
+
+    If [chkpos] is [false] then positivity is assumed, and
+    [check_positivity_one] computes the subterms occurrences in a
+    best-effort fashion. *)
+let check_positivity_one ~chkpos recursive (env,_,ntypes,_ as ienv) paramsctxt (_,i as ind) nnonrecargs lcnames indlc =
   let nparamsctxt = Context.Rel.length paramsctxt in
   let nmr = Context.Rel.nhyps paramsctxt in
   (** Positivity of one argument [c] of a constructor (i.e. the
       constructor [cn] has a type of the shape [… -> c … -> P], where,
       more generally, the arrows may be dependent). *)
   let rec check_pos (env, n, ntypes, ra_env as ienv) nmr c =
-    let x,largs = decompose_app (whd_betadeltaiota env c) in
+    let x,largs = decompose_app (whd_all env c) in
       match kind_of_term x with
 	| Prod (na,b,d) ->
 	    let () = assert (List.is_empty largs) in
@@ -501,12 +505,15 @@ let check_positivity_one recursive (env,_,ntypes,_ as ienv) paramsctxt (_,i as i
                 recursive call. Occurrences in the right-hand side of
                 the product must be strictly positive.*)
             (match weaker_noccur_between env n ntypes b with
-		None -> failwith_non_pos_list n ntypes [b]
+	      | None when chkpos ->
+                  failwith_non_pos_list n ntypes [b]
+              | None ->
+                  check_pos (ienv_push_var ienv (na, b, mk_norec)) nmr d
               | Some b ->
-	          check_pos (ienv_push_var ienv (na, b, mk_norec)) nmr d)
+                  check_pos (ienv_push_var ienv (na, b, mk_norec)) nmr d)
 	| Rel k ->
             (try let (ra,rarg) = List.nth ra_env (k-1) in
-            let largs = List.map (whd_betadeltaiota env) largs in
+            let largs = List.map (whd_all env) largs in
 	    let nmr1 =
 	      (match ra with
                   Mrec _ -> compute_rec_par ienv paramsctxt nmr largs
@@ -515,7 +522,8 @@ let check_positivity_one recursive (env,_,ntypes,_ as ienv) paramsctxt (_,i as i
               (** The case where one of the inductives of the mutually
                   inductive block occurs as an argument of another is not
                   known to be safe. So Coq rejects it. *)
-	      if not (List.for_all (noccur_between n ntypes) largs)
+	      if chkpos &&
+                 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))
@@ -530,8 +538,9 @@ let check_positivity_one recursive (env,_,ntypes,_ as ienv) paramsctxt (_,i as i
             (** If an inductive of the mutually inductive block
                 appears in any other way, then the positivy check gives
                 up. *)
-	    if noccur_between n ntypes x &&
-              List.for_all (noccur_between n ntypes) largs
+	    if not chkpos ||
+              (noccur_between n ntypes x &&
+               List.for_all (noccur_between n ntypes) largs)
 	    then (nmr,mk_norec)
 	    else failwith_non_pos_list n ntypes (x::largs)
 
@@ -553,7 +562,7 @@ let check_positivity_one recursive (env,_,ntypes,_ as ienv) paramsctxt (_,i as i
       (** Inductives of the inductive block being defined are only
           allowed to appear nested in the parameters of another inductive
           type. Not in the proper indices. *)
-      if not (List.for_all (noccur_between n ntypes) auxnonrecargs) then
+      if chkpos && not (List.for_all (noccur_between n ntypes) auxnonrecargs) then
 	failwith_non_pos_list n ntypes auxnonrecargs;
       (* Nested mutual inductive types are not supported *)
       let auxntyp = mib.mind_ntypes in
@@ -594,7 +603,7 @@ let check_positivity_one recursive (env,_,ntypes,_ as ienv) paramsctxt (_,i as i
       inductive type. *)
   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
+      let x,largs = decompose_app (whd_all env c) in
 	match kind_of_term x with
 
           | Prod (na,b,d) ->
@@ -613,7 +622,8 @@ let check_positivity_one recursive (env,_,ntypes,_ as ienv) paramsctxt (_,i as i
                 | _ -> raise (IllFormedInd (LocalNotConstructor(paramsctxt,nnonrecargs)))
                 end
               else
-                if not (List.for_all (noccur_between n ntypes) largs)
+                if chkpos &&
+                   not (List.for_all (noccur_between n ntypes) largs)
                 then failwith_non_pos_list n ntypes largs
             in
             (nmr, List.rev lrec)
@@ -633,9 +643,13 @@ let check_positivity_one recursive (env,_,ntypes,_ as ienv) paramsctxt (_,i as i
   and nmr' = array_min nmr irecargs_nmr
   in (nmr', mk_paths (Mrec ind) irecargs)
 
-(** [check_positivity kn env_ar paramsctxt inds] checks that the mutually
-    inductive block [inds] is strictly positive. *)
-let check_positivity kn env_ar_par paramsctxt finite inds =
+(** [check_positivity ~chkpos kn env_ar paramsctxt inds] checks that the mutually
+    inductive block [inds] is strictly positive.
+
+    If [chkpos] is [false] then positivity is assumed, and
+    [check_positivity_one] computes the subterms occurrences in a
+    best-effort fashion. *)
+let check_positivity ~chkpos kn env_ar_par paramsctxt finite inds =
   let ntypes = Array.length inds in
   let recursive = finite != Decl_kinds.BiFinite in
   let rc = Array.mapi (fun j t -> (Mrec (kn,j),t)) (Rtree.mk_rec_calls ntypes) in
@@ -647,7 +661,7 @@ let check_positivity kn env_ar_par paramsctxt finite inds =
       List.init nparamsctxt (fun _ -> (Norec,mk_norec)) @ ra_env_ar in
     let ienv = (env_ar_par, 1+nparamsctxt, ntypes, ra_env_ar_par) in
     let nnonrecargs = Context.Rel.nhyps sign - nmr in
-    check_positivity_one recursive ienv paramsctxt (kn,i) nnonrecargs lcnames lc
+    check_positivity_one ~chkpos recursive ienv paramsctxt (kn,i) nnonrecargs lcnames lc
   in
   let irecargs_nmr = Array.mapi check_one inds in
   let irecargs = Array.map snd irecargs_nmr
@@ -908,6 +922,7 @@ let build_inductive env p prv ctx env_ar paramsctxt kn isrecord isfinite inds nm
       mind_polymorphic = p;
       mind_universes = ctx;
       mind_private = prv;
+      mind_typing_flags = Environ.typing_flags env;
     }
 
 (************************************************************************)
@@ -917,7 +932,8 @@ let check_inductive env kn mie =
   (* First type-check the inductive definition *)
   let (env_ar, env_ar_par, paramsctxt, inds) = typecheck_inductive env mie in
   (* Then check positivity conditions *)
-  let (nmr,recargs) = check_positivity kn env_ar_par paramsctxt mie.mind_entry_finite inds in
+  let chkpos = (Environ.typing_flags env).check_guarded in
+  let (nmr,recargs) = check_positivity ~chkpos kn env_ar_par paramsctxt mie.mind_entry_finite inds in
   (* Build the inductive packets *)
     build_inductive env mie.mind_entry_polymorphic mie.mind_entry_private
       mie.mind_entry_universes
diff --git a/kernel/inductive.ml b/kernel/inductive.ml
index 499cbf0df..3c4c2796e 100644
--- a/kernel/inductive.ml
+++ b/kernel/inductive.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-open Errors
+open CErrors
 open Util
 open Names
 open Univ
@@ -29,20 +29,20 @@ let lookup_mind_specif env (kn,tyi) =
   (mib, mib.mind_packets.(tyi))
 
 let find_rectype env c =
-  let (t, l) = decompose_app (whd_betadeltaiota env c) in
+  let (t, l) = decompose_app (whd_all env c) in
   match kind_of_term t with
   | Ind ind -> (ind, l)
   | _ -> raise Not_found
 
 let find_inductive env c =
-  let (t, l) = decompose_app (whd_betadeltaiota env c) in
+  let (t, l) = decompose_app (whd_all env c) in
   match kind_of_term t with
     | Ind ind
         when (fst (lookup_mind_specif env (out_punivs ind))).mind_finite <> Decl_kinds.CoFinite -> (ind, l)
     | _ -> raise Not_found
 
 let find_coinductive env c =
-  let (t, l) = decompose_app (whd_betadeltaiota env c) in
+  let (t, l) = decompose_app (whd_all env c) in
   match kind_of_term t with
     | Ind ind
         when (fst (lookup_mind_specif env (out_punivs ind))).mind_finite == Decl_kinds.CoFinite -> (ind, l)
@@ -313,7 +313,7 @@ let check_allowed_sort ksort specif =
 let is_correct_arity env c pj ind specif params =
   let arsign,_ = get_instantiated_arity ind specif params in
   let rec srec env pt ar =
-    let pt' = whd_betadeltaiota env pt in
+    let pt' = whd_all env pt in
     match kind_of_term pt', ar with
       | Prod (na1,a1,t), (LocalAssum (_,a1'))::ar' ->
           let () =
@@ -323,7 +323,7 @@ let is_correct_arity env c pj ind specif params =
       (* The last Prod domain is the type of the scrutinee *)
       | Prod (na1,a1,a2), [] -> (* whnf of t was not needed here! *)
 	 let env' = push_rel (LocalAssum (na1,a1)) env in
-	 let ksort = match kind_of_term (whd_betadeltaiota env' a2) with
+	 let ksort = match kind_of_term (whd_all env' a2) with
 	 | Sort s -> family_of_sort s
 	 | _ -> raise (LocalArity None) in
 	 let dep_ind = build_dependent_inductive ind specif params in
@@ -563,7 +563,7 @@ let check_inductive_codomain env p =
   let env = push_rel_context absctx env in
   let arctx, s = dest_prod_assum env ar in
   let env = push_rel_context arctx env in
-  let i,l' = decompose_app (whd_betadeltaiota env s) in
+  let i,l' = decompose_app (whd_all env s) in
   isInd i
 
 (* The following functions are almost duplicated from indtypes.ml, except
@@ -586,7 +586,7 @@ let ienv_push_inductive (env, ra_env) ((mind,u),lpar) =
 
 let rec ienv_decompose_prod (env,_ as ienv) n c =
  if Int.equal n 0 then (ienv,c) else
-   let c' = whd_betadeltaiota env c in
+   let c' = whd_all env c in
    match kind_of_term c' with
    Prod(na,a,b) ->
      let ienv' = ienv_push_var ienv (na,a,mk_norec) in
@@ -618,7 +618,7 @@ close to check_positive in indtypes.ml, but does no positivity check and does no
 compute the number of recursive arguments. *)
 let get_recargs_approx env tree ind args =
   let rec build_recargs (env, ra_env as ienv) tree c =
-    let x,largs = decompose_app (whd_betadeltaiota env c) in
+    let x,largs = decompose_app (whd_all env c) in
     match kind_of_term x with
     | Prod (na,b,d) ->
        assert (List.is_empty largs);
@@ -677,7 +677,7 @@ let get_recargs_approx env tree ind args =
 
   and build_recargs_constructors ienv trees c =
     let rec recargs_constr_rec (env,ra_env as ienv) trees lrec c =
-      let x,largs = decompose_app (whd_betadeltaiota env c) in
+      let x,largs = decompose_app (whd_all env c) in
 	match kind_of_term x with
 
           | Prod (na,b,d) ->
@@ -706,7 +706,7 @@ let restrict_spec env spec p =
   let env = push_rel_context absctx env in
   let arctx, s = dest_prod_assum env ar in
   let env = push_rel_context arctx env in
-  let i,args = decompose_app (whd_betadeltaiota env s) in
+  let i,args = decompose_app (whd_all env s) in
   match kind_of_term i with
   | Ind i ->
      begin match spec with
@@ -727,7 +727,7 @@ let restrict_spec env spec p =
 
 let rec subterm_specif renv stack t =
   (* maybe reduction is not always necessary! *)
-  let f,l = decompose_app (whd_betadeltaiota renv.env t) in
+  let f,l = decompose_app (whd_all renv.env t) in
     match kind_of_term f with
     | Rel k -> subterm_var k renv
     | Case (ci,p,c,lbr) ->
@@ -854,11 +854,11 @@ let filter_stack_domain env ci p stack =
   if noccur_with_meta 1 (Context.Rel.length absctx) ar then stack
   else let env = push_rel_context absctx env in
   let rec filter_stack env ar stack =
-    let t = whd_betadeltaiota env ar in
+    let t = whd_all env ar in
     match stack, kind_of_term t with
     | elt :: stack', Prod (n,a,c0) ->
       let d = LocalAssum (n,a) in
-      let ty, args = decompose_app (whd_betadeltaiota env a) in
+      let ty, args = decompose_app (whd_all env a) in
       let elt = match kind_of_term ty with
       | Ind ind -> 
         let spec' = stack_element_specif elt in
@@ -990,6 +990,10 @@ let check_one_fix renv recpos trees def =
         | (Ind _ | Construct _) ->
             List.iter (check_rec_call renv []) l
 
+	| Proj (p, c) ->
+           List.iter (check_rec_call renv []) l;
+           check_rec_call renv [] c
+
         | Var id ->
             begin
               let open Context.Named.Declaration in
@@ -1009,8 +1013,6 @@ let check_one_fix renv recpos trees def =
         | (Evar _ | Meta _) -> ()
 
         | (App _ | LetIn _ | Cast _) -> assert false (* beta zeta reduction *)
-	
-	| Proj (p, c) -> check_rec_call renv [] c
 
   and check_nested_fix_body renv decr recArgsDecrArg body =
     if Int.equal decr 0 then
@@ -1047,7 +1049,7 @@ let inductive_of_mutfix env ((nvect,bodynum),(names,types,bodies as recdef)) =
     (* check fi does not appear in the k+1 first abstractions,
        gives the type of the k+1-eme abstraction (must be an inductive)  *)
     let rec check_occur env n def =
-      match kind_of_term (whd_betadeltaiota env def) with
+      match kind_of_term (whd_all env def) with
         | Lambda (x,a,b) ->
 	    if noccur_with_meta n nbfix a then
 	      let env' = push_rel (LocalAssum (x,a)) env in
@@ -1068,20 +1070,24 @@ let inductive_of_mutfix env ((nvect,bodynum),(names,types,bodies as recdef)) =
 
 
 let check_fix env ((nvect,_),(names,_,bodies as recdef) as fix) =
-  let (minds, rdef) = inductive_of_mutfix env fix in
-  let get_tree (kn,i) =
-    let mib = Environ.lookup_mind kn env in
-    mib.mind_packets.(i).mind_recargs
-  in
-  let trees = Array.map (fun (mind,_) -> get_tree mind) minds in
-  for i = 0 to Array.length bodies - 1 do
-    let (fenv,body) = rdef.(i) in
-    let renv = make_renv fenv nvect.(i) trees.(i) in
-    try check_one_fix renv nvect trees body
-    with FixGuardError (fixenv,err) ->
-      error_ill_formed_rec_body fixenv err names i
-	(push_rec_types recdef env) (judgment_of_fixpoint recdef)
-  done
+  let flags = Environ.typing_flags env in
+  if flags.check_guarded then
+    let (minds, rdef) = inductive_of_mutfix env fix in
+    let get_tree (kn,i) =
+      let mib = Environ.lookup_mind kn env in
+      mib.mind_packets.(i).mind_recargs
+    in
+    let trees = Array.map (fun (mind,_) -> get_tree mind) minds in
+    for i = 0 to Array.length bodies - 1 do
+      let (fenv,body) = rdef.(i) in
+      let renv = make_renv fenv nvect.(i) trees.(i) in
+      try check_one_fix renv nvect trees body
+      with FixGuardError (fixenv,err) ->
+        error_ill_formed_rec_body fixenv err names i
+	  (push_rec_types recdef env) (judgment_of_fixpoint recdef)
+    done
+  else
+    ()
 
 (*
 let cfkey = Profile.declare_profile "check_fix";;
@@ -1097,7 +1103,7 @@ let anomaly_ill_typed () =
   anomaly ~label:"check_one_cofix" (Pp.str "too many arguments applied to constructor")
 
 let rec codomain_is_coind env c =
-  let b = whd_betadeltaiota env c in
+  let b = whd_all env c in
   match kind_of_term b with
     | Prod (x,a,b) ->
 	codomain_is_coind (push_rel (LocalAssum (x,a)) env) b
@@ -1109,7 +1115,7 @@ let rec codomain_is_coind env c =
 let check_one_cofix env nbfix def deftype =
   let rec check_rec_call env alreadygrd n tree vlra  t =
     if not (noccur_with_meta n nbfix t) then
-      let c,args = decompose_app (whd_betadeltaiota env t) in
+      let c,args = decompose_app (whd_all env t) in
       match kind_of_term c with
 	| Rel p when  n <= p && p < n+nbfix ->
 	    (* recursive call: must be guarded and no nested recursive
@@ -1193,11 +1199,15 @@ let check_one_cofix env nbfix def deftype =
    satisfies the guarded condition *)
 
 let check_cofix env (bodynum,(names,types,bodies as recdef)) =
-  let nbfix = Array.length bodies in
-  for i = 0 to nbfix-1 do
-    let fixenv = push_rec_types recdef env in
-    try check_one_cofix fixenv nbfix bodies.(i) types.(i)
-    with CoFixGuardError (errenv,err) ->
-      error_ill_formed_rec_body errenv err names i
-	fixenv (judgment_of_fixpoint recdef)
-  done
+  let flags = Environ.typing_flags env in
+  if flags.check_guarded then
+    let nbfix = Array.length bodies in
+    for i = 0 to nbfix-1 do
+      let fixenv = push_rec_types recdef env in
+      try check_one_cofix fixenv nbfix bodies.(i) types.(i)
+      with CoFixGuardError (errenv,err) ->
+        error_ill_formed_rec_body errenv err names i
+	  fixenv (judgment_of_fixpoint recdef)
+    done
+  else
+    ()
diff --git a/kernel/inductive.mli b/kernel/inductive.mli
index c0d18bc6e..521ee3c7b 100644
--- a/kernel/inductive.mli
+++ b/kernel/inductive.mli
@@ -94,6 +94,9 @@ val inductive_sort_family : one_inductive_body -> sorts_family
 val check_case_info : env -> pinductive -> case_info -> unit
 
 (** {6 Guard conditions for fix and cofix-points. } *)
+
+(** When [chk] is false, the guard condition is not actually
+    checked. *)
 val check_fix : env -> fixpoint -> unit
 val check_cofix : env -> cofixpoint -> unit
 
diff --git a/kernel/kernel.mllib b/kernel/kernel.mllib
index f7220c94a..4c540a6d7 100644
--- a/kernel/kernel.mllib
+++ b/kernel/kernel.mllib
@@ -15,7 +15,6 @@ Copcodes
 Cemitcodes
 Nativevalues
 Primitives
-Nativeinstr
 Opaqueproof
 Declareops
 Retroknowledge
@@ -26,14 +25,13 @@ Nativelambda
 Nativecode
 Nativelib
 Environ
-Closure
+CClosure
 Reduction
 Nativeconv
 Type_errors
 Modops
 Inductive
 Typeops
-Fast_typeops
 Indtypes
 Cooking
 Term_typing
diff --git a/kernel/make-opcodes b/kernel/make-opcodes
index c8f573c68..e1371b3d0 100644
--- a/kernel/make-opcodes
+++ b/kernel/make-opcodes
@@ -1,2 +1,3 @@
 $1=="enum" {n=0; next; }
-           {for (i = 1; i <= NF; i++) {printf("let op%s = %d\n", $i, n++);}}
+           {printf("(* THIS FILE IS GENERATED. DON'T EDIT. *)\n\n");
+           for (i = 1; i <= NF; i++) {printf("let op%s = %d\n", $i, n++);}}
diff --git a/kernel/modops.ml b/kernel/modops.ml
index 6fe7e382c..0f0056ed4 100644
--- a/kernel/modops.ml
+++ b/kernel/modops.ml
@@ -264,7 +264,7 @@ let add_retroknowledge mp =
     |Retroknowledge.RKRegister (f, e) when (isConst e || isInd e) ->
       Environ.register env f e
     |_ ->
-      Errors.anomaly ~label:"Modops.add_retroknowledge"
+      CErrors.anomaly ~label:"Modops.add_retroknowledge"
         (Pp.str "had to import an unsupported kind of term")
   in
   fun lclrk env ->
diff --git a/kernel/names.ml b/kernel/names.ml
index 9abc9842a..1f138581c 100644
--- a/kernel/names.ml
+++ b/kernel/names.ml
@@ -34,9 +34,15 @@ struct
 
   let hash = String.hash
 
+  let warn_invalid_identifier =
+    CWarnings.create ~name:"invalid-identifier" ~category:"parsing"
+                     ~default:CWarnings.Disabled
+                     (fun s -> str s)
+
   let check_soft ?(warn = true) x =
     let iter (fatal, x) =
-      if fatal then Errors.error x else if warn then Feedback.msg_warning (str x)
+      if fatal then CErrors.error x else
+        if warn then warn_invalid_identifier x
     in
     Option.iter iter (Unicode.ident_refutation x)
 
@@ -82,11 +88,14 @@ struct
   type t = Anonymous     (** anonymous identifier *)
 	 | Name of Id.t  (** non-anonymous identifier *)
 
+  let mk_name id =
+    Name id
+
   let is_anonymous = function
     | Anonymous -> true
     | Name _ -> false
 
-  let is_name = not % is_anonymous
+  let is_name = is_anonymous %> not
 
   let compare n1 n2 = match n1, n2 with
     | Anonymous, Anonymous -> 0
@@ -595,7 +604,13 @@ end
 module Constant = KerPair
 
 module Cmap = HMap.Make(Constant.CanOrd)
+(** A map whose keys are constants (values of the {!Constant.t} type).
+    Keys are ordered wrt. "cannonical form" of the constant. *)
+
 module Cmap_env = HMap.Make(Constant.UserOrd)
+(** A map whose keys are constants (values of the {!Constant.t} type).
+    Keys are ordered wrt. "user form" of the constant. *)
+
 module Cpred = Predicate.Make(Constant.CanOrd)
 module Cset = Cmap.Set
 module Cset_env = Cmap_env.Set
diff --git a/kernel/names.mli b/kernel/names.mli
index 56f0f8c60..6b0a80625 100644
--- a/kernel/names.mli
+++ b/kernel/names.mli
@@ -6,6 +6,20 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
+(** This file defines a lot of different notions of names used pervasively in
+    the kernel as well as in other places. The essential datatypes exported by
+    this API are:
+
+    - Id.t is the type of identifiers, that is morally a subset of strings which
+      only contains Unicode characters of the Letter kind (and a few more).
+    - Name.t is an ad-hoc variant of Id.t option allowing to handle optionally
+      named objects.
+    - DirPath.t represents generic paths as sequences of identifiers.
+    - Label.t is an equivalent of Id.t made distinct for semantical purposes.
+    - ModPath.t are module paths.
+    - KerName.t are absolute names of objects in Coq.
+*)
+
 open Util
 
 (** {6 Identifiers } *)
@@ -68,6 +82,9 @@ sig
   type t = Anonymous     (** anonymous identifier *)
 	 | Name of Id.t  (** non-anonymous identifier *)
 
+  val mk_name : Id.t -> t
+  (** constructor *)
+
   val is_anonymous : t -> bool
   (** Return [true] iff a given name is [Anonymous]. *)
 
@@ -354,8 +371,14 @@ end
 module Cpred : Predicate.S with type elt = Constant.t
 module Cset : CSig.SetS with type elt = Constant.t
 module Cset_env  : CSig.SetS with type elt = Constant.t
+
 module Cmap : Map.ExtS with type key = Constant.t and module Set := Cset
+(** A map whose keys are constants (values of the {!Constant.t} type).
+    Keys are ordered wrt. "cannonical form" of the constant. *)
+
 module Cmap_env : Map.ExtS with type key = Constant.t  and module Set := Cset_env
+(** A map whose keys are constants (values of the {!Constant.t} type).
+    Keys are ordered wrt. "user form" of the constant. *)
 
 (** {6 Inductive names} *)
 
diff --git a/kernel/nativecode.ml b/kernel/nativecode.ml
index 44cf21cff..33bd7d8dd 100644
--- a/kernel/nativecode.ml
+++ b/kernel/nativecode.ml
@@ -5,7 +5,8 @@
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
-open Errors
+
+open CErrors
 open Names
 open Term
 open Declarations
@@ -21,8 +22,12 @@ to OCaml code. *)
 
 (** Local names **)
 
+(* The first component is there for debugging purposes only *)
 type lname = { lname : name; luid : int }
 
+let eq_lname ln1 ln2 =
+  Int.equal ln1.luid ln2.luid
+
 let dummy_lname = { lname = Anonymous; luid = -1 }
 
 module LNord = 
@@ -81,6 +86,9 @@ let eq_gname gn1 gn2 =
   | Gnamed id1, Gnamed id2 -> Id.equal id1 id2
   | _ -> false
 
+let dummy_gname =
+  Grel 0
+
 open Hashset.Combine
 
 let gname_hash gn = match gn with
@@ -403,9 +411,13 @@ let opush_lnames n env lns =
 let rec eq_mllambda gn1 gn2 n env1 env2 t1 t2 =
   match t1, t2 with
   | MLlocal ln1, MLlocal ln2 ->
+     (try
       Int.equal (LNmap.find ln1 env1) (LNmap.find ln2 env2)
+     with Not_found ->
+      eq_lname ln1 ln2)
   | MLglobal gn1', MLglobal gn2' ->
       eq_gname gn1' gn2' || (eq_gname gn1 gn1' && eq_gname gn2 gn2')
+      || (eq_gname gn1 gn2' && eq_gname gn2 gn1')
   | MLprimitive prim1, MLprimitive prim2 -> eq_primitive prim1 prim2
   | MLlam (lns1, ml1), MLlam (lns2, ml2) ->
       Int.equal (Array.length lns1) (Array.length lns2) &&
@@ -718,6 +730,11 @@ let push_global_norm gn params body =
 let push_global_case gn params annot a accu bs =
   push_global gn (Gletcase (gn, params, annot, a, accu, bs))
 
+(* Compares [t1] and [t2] up to alpha-equivalence. [t1] and [t2] may contain
+   free variables. *)
+let eq_mllambda t1 t2 =
+  eq_mllambda dummy_gname dummy_gname 0 LNmap.empty LNmap.empty t1 t2
+
 (*s Compilation environment *)
 
 type env =
@@ -896,9 +913,7 @@ let rec insert cargs body rl =
      let params = rm_params fv params in
      rl:= Rcons(ref [(c,params)], fv, body, ref Rnil)
  | Rcons(l,fv,body',rl) ->
-    (** ppedrot: It seems we only want to factorize common branches. It should
-        not matter to do so with a subapproximation by (==). *)
-     if body == body' then
+     if eq_mllambda body body' then
        let (c,params) = cargs in
        let params = rm_params fv params in
        l := (c,params)::!l
@@ -1445,12 +1460,14 @@ let optimize gdef l =
 
 	end
     | MLif(t,b1,b2) ->
+       (* This optimization is critical: it applies to all fixpoints that start
+       by matching on their recursive argument *)
 	let t = optimize s t in
 	let b1 = optimize s b1 in
 	let b2 = optimize s b2 in
 	begin match t, b2 with
 	| MLapp(MLprimitive Is_accu,[| l1 |]), MLmatch(annot, l2, _, bs)
-	    when l1 == l2 -> MLmatch(annot, l1, b1, bs) (** approximation *)
+	    when eq_mllambda l1 l2 -> MLmatch(annot, l1, b1, bs)
         | _, _ -> MLif(t, b1, b2)
 	end
     | MLmatch(annot,a,accu,bs) ->
@@ -1831,10 +1848,9 @@ and apply_fv env sigma univ (fv_named,fv_rel) auxdefs ml =
   auxdefs, MLlet(aux_name, ml, mkMLapp (MLlocal aux_name) (Array.of_list (fv_rel@fv_named)))
 
 and compile_rel env sigma univ auxdefs n =
-  let open Context.Rel in
-  let n = length env.env_rel_context - n in
-  let open Declaration in
-  match lookup n env.env_rel_context with
+  let n = Context.Rel.length env.env_rel_context - n in
+  let open Context.Rel.Declaration in
+  match Context.Rel.lookup n env.env_rel_context with
   | LocalDef (_,t,_) ->
       let code = lambda_of_constr env sigma t in
       let auxdefs,code = compile_with_fv env sigma univ auxdefs None code in
@@ -1844,7 +1860,7 @@ and compile_rel env sigma univ auxdefs n =
 
 and compile_named env sigma univ auxdefs id =
   let open Context.Named.Declaration in
-  match Context.Named.lookup id env.env_named_context with
+  match lookup_named id env with
   | LocalDef (_,t,_) ->
       let code = lambda_of_constr env sigma t in
       let auxdefs,code = compile_with_fv env sigma univ auxdefs None code in
@@ -1929,13 +1945,15 @@ let compile_constant env sigma prefix ~interactive con cb =
           arg|])))::
             [Glet(gn, mkMLlam [|c_uid|] code)], Linked prefix
 
-let loaded_native_files = ref ([] : string list)
+module StringOrd = struct type t = string let compare = String.compare end
+module StringSet = Set.Make(StringOrd)
+
+let loaded_native_files = ref StringSet.empty
 
-let is_loaded_native_file s = String.List.mem s !loaded_native_files
+let is_loaded_native_file s = StringSet.mem s !loaded_native_files
 
 let register_native_file s =
-  if not (is_loaded_native_file s) then
-    loaded_native_files := s :: !loaded_native_files
+  loaded_native_files := StringSet.add s !loaded_native_files
 
 let is_code_loaded ~interactive name =
   match !name with
diff --git a/kernel/nativeconv.ml b/kernel/nativeconv.ml
index a0ff9e123..3c0afe380 100644
--- a/kernel/nativeconv.ml
+++ b/kernel/nativeconv.ml
@@ -5,7 +5,8 @@
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
-open Errors
+
+open CErrors
 open Names
 open Nativelib
 open Reduction
@@ -145,11 +146,16 @@ let native_conv_gen pb sigma env univs t1 t2 =
       end
   | _ -> anomaly (Pp.str "Compilation failure") 
 
+let warn_no_native_compiler =
+  let open Pp in
+  CWarnings.create ~name:"native-compiler-disabled" ~category:"native-compiler"
+         (fun () -> strbrk "Native compiler is disabled," ++
+                      strbrk " falling back to VM conversion test.")
+
 (* Wrapper for [native_conv] above *)
 let native_conv cv_pb sigma env t1 t2 =
   if Coq_config.no_native_compiler then begin
-    let msg = "Native compiler is disabled, falling back to VM conversion test." in
-    Feedback.msg_warning (Pp.str msg);
+    warn_no_native_compiler ();
     vm_conv cv_pb env t1 t2
   end
   else
diff --git a/kernel/nativelambda.ml b/kernel/nativelambda.ml
index 91b40be7e..366f9a0a6 100644
--- a/kernel/nativelambda.ml
+++ b/kernel/nativelambda.ml
@@ -14,6 +14,8 @@ open Pre_env
 open Nativevalues
 open Nativeinstr
 
+module RelDecl = Context.Rel.Declaration
+
 (** This file defines the lambda code generation phase of the native compiler *)
 
 exception NotClosed
@@ -727,8 +729,7 @@ let optimize lam =
 let lambda_of_constr env sigma c =
   set_global_env env;
   let env = Renv.make () in
-  let open Context.Rel.Declaration in
-  let ids = List.rev_map get_name !global_env.env_rel_context in
+  let ids = List.rev_map RelDecl.get_name !global_env.env_rel_context in
   Renv.push_rels env (Array.of_list ids);
   let lam = lambda_of_constr env sigma c in
 (*  if Flags.vm_draw_opt () then begin
diff --git a/kernel/nativelib.ml b/kernel/nativelib.ml
index 5b92e9554..6bd82170e 100644
--- a/kernel/nativelib.ml
+++ b/kernel/nativelib.ml
@@ -8,7 +8,7 @@
 open Util
 open Nativevalues
 open Nativecode
-open Errors
+open CErrors
 open Envars
 
 (** This file provides facilities to access OCaml compiler and dynamic linker,
@@ -35,7 +35,7 @@ let ( / ) = Filename.concat
 (* We have to delay evaluation of include_dirs because coqlib cannot be guessed
 until flags have been properly initialized *)
 let include_dirs () =
-  [Filename.temp_dir_name; coqlib () / "kernel"; coqlib () / "library"]
+  [Filename.get_temp_dir_name (); coqlib () / "kernel"; coqlib () / "library"]
 
 (* Pointer to the function linking an ML object into coq's toplevel *)
 let load_obj = ref (fun x -> () : string -> unit)
@@ -55,6 +55,15 @@ let write_ml_code fn ?(header=[]) code =
   List.iter (pp_global fmt) (header@code);
   close_out ch_out
 
+let warn_native_compiler_failed =
+  let print = function
+  | Inl (Unix.WEXITED n) -> Pp.(strbrk "Native compiler exited with status" ++ str" " ++ int n)
+  | Inl (Unix.WSIGNALED n) -> Pp.(strbrk "Native compiler killed by signal" ++ str" " ++ int n)
+  | Inl (Unix.WSTOPPED n) -> Pp.(strbrk "Native compiler stopped by signal" ++ str" " ++ int n)
+  | Inr e -> Pp.(strbrk "Native compiler failed with error: " ++ strbrk (Unix.error_message e))
+  in
+  CWarnings.create ~name:"native-compiler-failed" ~category:"native-compiler" print
+
 let call_compiler ml_filename =
   let load_path = !get_load_paths () in
   let load_path = List.map (fun dn -> dn / output_dir) load_path in
@@ -78,15 +87,12 @@ let call_compiler ml_filename =
     let res = CUnix.sys_command (ocamlfind ()) args in
     let res = match res with
       | Unix.WEXITED 0 -> true
-      | Unix.WEXITED n ->
-         Feedback.msg_warning Pp.(str "command exited with status " ++ int n); false
-      | Unix.WSIGNALED n ->
-         Feedback.msg_warning Pp.(str "command killed by signal " ++ int n); false
-      | Unix.WSTOPPED n ->
-         Feedback.msg_warning Pp.(str "command stopped by signal " ++ int n); false in
+      | Unix.WEXITED n | Unix.WSIGNALED n | Unix.WSTOPPED n ->
+        warn_native_compiler_failed (Inl res); false
+    in
     res, link_filename
   with Unix.Unix_error (e,_,_) ->
-    Feedback.msg_warning Pp.(str (Unix.error_message e));
+    warn_native_compiler_failed (Inr e);
     false, link_filename
 
 let compile fn code =
@@ -119,7 +125,7 @@ let call_linker ?(fatal=true) prefix f upds =
   if not (Sys.file_exists f) then
     begin
       let msg = "Cannot find native compiler file " ^ f in
-      if fatal then Errors.error msg
+      if fatal then CErrors.error msg
       else if !Flags.debug then Feedback.msg_debug (Pp.str msg)
     end
   else
@@ -127,7 +133,7 @@ let call_linker ?(fatal=true) prefix f upds =
     if Dynlink.is_native then Dynlink.loadfile f else !load_obj f;
     register_native_file prefix
    with Dynlink.Error e as exn ->
-     let exn = Errors.push exn in
+     let exn = CErrors.push exn in
      let msg = "Dynlink error, " ^ Dynlink.error_message e in
      if fatal then (Feedback.msg_error (Pp.str msg); iraise exn)
      else if !Flags.debug then Feedback.msg_debug (Pp.str msg));
diff --git a/kernel/nativevalues.ml b/kernel/nativevalues.ml
index d6fdfefa0..8093df304 100644
--- a/kernel/nativevalues.ml
+++ b/kernel/nativevalues.ml
@@ -7,7 +7,7 @@
 (************************************************************************)
 open Term
 open Names
-open Errors
+open CErrors
 open Util
 
 (** This module defines the representation of values internally used by
diff --git a/kernel/opaqueproof.ml b/kernel/opaqueproof.ml
index 0c8772d8d..130f1eb03 100644
--- a/kernel/opaqueproof.ml
+++ b/kernel/opaqueproof.ml
@@ -26,10 +26,10 @@ let empty_opaquetab = Int.Map.empty, DirPath.initial
 
 (* hooks *)
 let default_get_opaque dp _ =
-  Errors.error
+  CErrors.error
     ("Cannot access opaque proofs in library " ^ DirPath.to_string dp)
 let default_get_univ dp _ =
-  Errors.error
+  CErrors.error
     ("Cannot access universe constraints of opaque proofs in library " ^
     DirPath.to_string dp)
 
@@ -45,8 +45,8 @@ let create cu = Direct ([],cu)
 let turn_indirect dp o (prfs,odp) = match o with
   | Indirect (_,_,i) ->
       if not (Int.Map.mem i prfs)
-      then Errors.anomaly (Pp.str "Indirect in a different table")
-      else Errors.anomaly (Pp.str "Already an indirect opaque")
+      then CErrors.anomaly (Pp.str "Indirect in a different table")
+      else CErrors.anomaly (Pp.str "Already an indirect opaque")
   | Direct (d,cu) ->
       let cu = Future.chain ~pure:true cu (fun (c, u) -> hcons_constr c, u) in
       let id = Int.Map.cardinal prfs in
@@ -54,21 +54,21 @@ let turn_indirect dp o (prfs,odp) = match o with
       let ndp =
         if DirPath.equal dp odp then odp
         else if DirPath.equal odp DirPath.initial then dp
-        else Errors.anomaly
+        else CErrors.anomaly
           (Pp.str "Using the same opaque table for multiple dirpaths") in
       Indirect ([],dp,id), (prfs, ndp)
 
 let subst_opaque sub = function
   | Indirect (s,dp,i) -> Indirect (sub::s,dp,i)
-  | Direct _ -> Errors.anomaly (Pp.str "Substituting a Direct opaque")
+  | Direct _ -> CErrors.anomaly (Pp.str "Substituting a Direct opaque")
 
 let iter_direct_opaque f = function
-  | Indirect _ -> Errors.anomaly (Pp.str "Not a direct opaque")
+  | Indirect _ -> CErrors.anomaly (Pp.str "Not a direct opaque")
   | Direct (d,cu) ->
       Direct (d,Future.chain ~pure:true cu (fun (c, u) -> f c; c, u))
 
 let discharge_direct_opaque ~cook_constr ci = function
-  | Indirect _ -> Errors.anomaly (Pp.str "Not a direct opaque")
+  | Indirect _ -> CErrors.anomaly (Pp.str "Not a direct opaque")
   | Direct (d,cu) ->
       Direct (ci::d,Future.chain ~pure:true cu (fun (c, u) -> cook_constr c, u))
 
diff --git a/kernel/pre_env.ml b/kernel/pre_env.ml
index c30789641..d14a254d3 100644
--- a/kernel/pre_env.ml
+++ b/kernel/pre_env.ml
@@ -17,7 +17,8 @@ open Util
 open Names
 open Term
 open Declarations
-open Context.Named.Declaration
+
+module NamedDecl = Context.Named.Declaration
 
 (* The type of environments. *)
 
@@ -61,24 +62,28 @@ let force_lazy_val vk = match !vk with
 let dummy_lazy_val () = ref VKnone
 let build_lazy_val vk key = vk := VKvalue (CEphemeron.create key)
 
-type named_vals = (Id.t * lazy_val) list
+type named_context_val = {
+  env_named_ctx : Context.Named.t;
+  env_named_map : (Context.Named.Declaration.t * lazy_val) Id.Map.t;
+}
 
 type env = {
   env_globals       : globals;
-  env_named_context : Context.Named.t;
-  env_named_vals    : named_vals;
+  env_named_context : named_context_val;
   env_rel_context   : Context.Rel.t;
   env_rel_val       : lazy_val list;
   env_nb_rel        : int;
   env_stratification : stratification;
+  env_typing_flags  : typing_flags;
   env_conv_oracle   : Conv_oracle.oracle;
   retroknowledge : Retroknowledge.retroknowledge;
   indirect_pterms : Opaqueproof.opaquetab;
 }
 
-type named_context_val = Context.Named.t * named_vals
-
-let empty_named_context_val = [],[]
+let empty_named_context_val = {
+  env_named_ctx = [];
+  env_named_map = Id.Map.empty;
+}
 
 let empty_env = {
   env_globals = {
@@ -86,14 +91,14 @@ let empty_env = {
     env_inductives = Mindmap_env.empty;
     env_modules = MPmap.empty;
     env_modtypes = MPmap.empty};
-  env_named_context = Context.Named.empty;
-  env_named_vals = [];
+  env_named_context = empty_named_context_val;
   env_rel_context = Context.Rel.empty;
   env_rel_val = [];
   env_nb_rel = 0;
   env_stratification = {
     env_universes = UGraph.initial_universes;
-    env_engagement = (PredicativeSet,StratifiedType) };
+    env_engagement = PredicativeSet };
+  env_typing_flags = Declareops.safe_flags;
   env_conv_oracle = Conv_oracle.empty;
   retroknowledge = Retroknowledge.initial_retroknowledge;
   indirect_pterms = Opaqueproof.empty_opaquetab }
@@ -123,28 +128,58 @@ let env_of_rel n env =
 
 (* Named context *)
 
-let push_named_context_val d (ctxt,vals) =
-  let rval = ref VKnone in
-    Context.Named.add d ctxt, (get_id d,rval)::vals
+let push_named_context_val_val d rval ctxt =
+(*   assert (not (Id.Map.mem (NamedDecl.get_id d) ctxt.env_named_map)); *)
+  {
+    env_named_ctx = Context.Named.add d ctxt.env_named_ctx;
+    env_named_map = Id.Map.add (NamedDecl.get_id d) (d, rval) ctxt.env_named_map;
+  }
+
+let push_named_context_val d ctxt =
+  push_named_context_val_val d (ref VKnone) ctxt
+
+let match_named_context_val c = match c.env_named_ctx with
+| [] -> None
+| decl :: ctx ->
+  let (_, v) = Id.Map.find (NamedDecl.get_id decl) c.env_named_map in
+  let map = Id.Map.remove (NamedDecl.get_id decl) c.env_named_map in
+  let cval = { env_named_ctx = ctx; env_named_map = map } in
+  Some (decl, v, cval)
+
+let map_named_val f ctxt =
+  let open Context.Named.Declaration in
+  let fold accu d =
+    let d' = map_constr f d in
+    let accu =
+      if d == d' then accu
+      else Id.Map.modify (get_id d) (fun _ (_, v) -> (d', v)) accu
+    in
+    (accu, d')
+  in
+  let map, ctx = List.fold_map fold ctxt.env_named_map ctxt.env_named_ctx in
+  if map == ctxt.env_named_map then ctxt
+  else { env_named_ctx = ctx; env_named_map = map }
 
 let push_named d env =
 (*  if not (env.env_rel_context = []) then raise (ASSERT env.env_rel_context);
   assert (env.env_rel_context = []); *)
-  let rval = ref VKnone in
   { env_globals = env.env_globals;
-    env_named_context = Context.Named.add d env.env_named_context;
-    env_named_vals = (get_id d, rval) :: env.env_named_vals;
+    env_named_context = push_named_context_val d env.env_named_context;
     env_rel_context = env.env_rel_context;
     env_rel_val = env.env_rel_val;
     env_nb_rel = env.env_nb_rel;
     env_stratification = env.env_stratification;
+    env_typing_flags = env.env_typing_flags;
     env_conv_oracle = env.env_conv_oracle;
     retroknowledge = env.retroknowledge;
     indirect_pterms = env.indirect_pterms;
   }
 
+let lookup_named id env =
+  fst (Id.Map.find id env.env_named_context.env_named_map)
+
 let lookup_named_val id env =
-  snd(List.find (fun (id',_) -> Id.equal id id') env.env_named_vals)
+  snd(Id.Map.find id env.env_named_context.env_named_map)
 
 (* Warning all the names should be different *)
 let env_of_named id env = env
diff --git a/kernel/pre_env.mli b/kernel/pre_env.mli
index 353c46112..866790367 100644
--- a/kernel/pre_env.mli
+++ b/kernel/pre_env.mli
@@ -40,23 +40,24 @@ val force_lazy_val : lazy_val -> (values * Id.Set.t) option
 val dummy_lazy_val : unit -> lazy_val
 val build_lazy_val : lazy_val -> (values * Id.Set.t) -> unit
 
-type named_vals = (Id.t * lazy_val) list
+type named_context_val = private {
+  env_named_ctx : Context.Named.t;
+  env_named_map : (Context.Named.Declaration.t * lazy_val) Id.Map.t;
+}
 
 type env = {
     env_globals       : globals;
-    env_named_context : Context.Named.t;
-    env_named_vals    : named_vals;
+    env_named_context : named_context_val;
     env_rel_context   : Context.Rel.t;
     env_rel_val       : lazy_val list;
     env_nb_rel        : int;
     env_stratification : stratification;
+    env_typing_flags  : typing_flags;
     env_conv_oracle   : Conv_oracle.oracle;
     retroknowledge : Retroknowledge.retroknowledge;
     indirect_pterms : Opaqueproof.opaquetab;
 }
 
-type named_context_val = Context.Named.t * named_vals
-
 val empty_named_context_val : named_context_val
 
 val empty_env : env
@@ -72,7 +73,15 @@ val env_of_rel     : int -> env -> env
 
 val push_named_context_val  :
     Context.Named.Declaration.t -> named_context_val -> named_context_val
+val push_named_context_val_val  :
+    Context.Named.Declaration.t -> lazy_val -> named_context_val -> named_context_val
+val match_named_context_val  :
+  named_context_val -> (Context.Named.Declaration.t * lazy_val * named_context_val) option
+val map_named_val :
+   (constr -> constr) -> named_context_val -> named_context_val
+
 val push_named       : Context.Named.Declaration.t -> env -> env
+val lookup_named     : Id.t -> env -> Context.Named.Declaration.t
 val lookup_named_val : Id.t -> env -> lazy_val
 val env_of_named     : Id.t -> env -> env
 
diff --git a/kernel/reduction.ml b/kernel/reduction.ml
index 30a346c91..1ae89347a 100644
--- a/kernel/reduction.ml
+++ b/kernel/reduction.ml
@@ -15,13 +15,13 @@
 (* Equal inductive types by Jacek Chrzaszcz as part of the module
    system, Aug 2002 *)
 
-open Errors
+open CErrors
 open Util
 open Names
 open Term
 open Vars
 open Environ
-open Closure
+open CClosure
 open Esubst
 open Context.Rel.Declaration
 
@@ -107,17 +107,17 @@ let whd_betaiotazeta env x =
        Prod _|Lambda _|Fix _|CoFix _) -> x
     | _ -> whd_val (create_clos_infos betaiotazeta env) (inject x)
 
-let whd_betadeltaiota env t =
+let whd_all env t =
   match kind_of_term t with
     | (Sort _|Meta _|Evar _|Ind _|Construct _|
        Prod _|Lambda _|Fix _|CoFix _) -> t
-    | _ -> whd_val (create_clos_infos betadeltaiota env) (inject t)
+    | _ -> whd_val (create_clos_infos all env) (inject t)
 
-let whd_betadeltaiota_nolet env t =
+let whd_allnolet env t =
   match kind_of_term t with
     | (Sort _|Meta _|Evar _|Ind _|Construct _|
        Prod _|Lambda _|Fix _|CoFix _|LetIn _) -> t
-    | _ -> whd_val (create_clos_infos betadeltaiotanolet env) (inject t)
+    | _ -> whd_val (create_clos_infos allnolet env) (inject t)
 
 (********************************************************************)
 (*                         Conversion                               *)
@@ -316,9 +316,9 @@ and eqappr cv_pb l2r infos (lft1,st1) (lft2,st2) cuniv =
       (try
 	 let cuniv = conv_table_key infos fl1 fl2 cuniv in
 	   convert_stacks l2r infos lft1 lft2 v1 v2 cuniv
-       with NotConvertible ->
+       with NotConvertible | Univ.UniverseInconsistency _ ->
            (* else the oracle tells which constant is to be expanded *)
-	 let oracle = Closure.oracle_of_infos infos in
+	 let oracle = CClosure.oracle_of_infos infos in
          let (app1,app2) =
            if Conv_oracle.oracle_order Univ.out_punivs oracle l2r fl1 fl2 then
 	     match unfold_reference infos fl1 with
@@ -537,7 +537,7 @@ and convert_vect l2r infos lft1 lft2 v1 v2 cuniv =
   else raise NotConvertible
 
 let clos_gen_conv trans cv_pb l2r evars env univs t1 t2 =
-  let reds = Closure.RedFlags.red_add_transparent betaiotazeta trans in
+  let reds = CClosure.RedFlags.red_add_transparent betaiotazeta trans in
   let infos = create_clos_infos ~evars reds env in
   ccnv cv_pb l2r infos el_id el_id (inject t1) (inject t2) univs
 
@@ -676,12 +676,18 @@ let infer_conv_leq ?(l2r=false) ?(evars=fun _ -> None) ?(ts=full_transparent_sta
 let vm_conv = ref (fun cv_pb env ->
 		   gen_conv cv_pb env ~evars:((fun _->None), universes env))
 
+let warn_bytecode_compiler_failed =
+  let open Pp in
+  CWarnings.create ~name:"bytecode-compiler-failed" ~category:"bytecode-compiler"
+         (fun () -> strbrk "Bytecode compiler failed, " ++
+                      strbrk "falling back to standard conversion")
+
 let set_vm_conv (f:conv_pb -> Term.types kernel_conversion_function) = vm_conv := f
 let vm_conv cv_pb env t1 t2 =
   try
     !vm_conv cv_pb env t1 t2
   with Not_found | Invalid_argument _ ->
-    Feedback.msg_warning (Pp.str "Bytecode compilation failed, falling back to standard conversion");
+    warn_bytecode_compiler_failed ();
     gen_conv cv_pb env t1 t2
 
 let default_conv cv_pb ?(l2r=false) env t1 t2 =
@@ -725,7 +731,7 @@ let betazeta_appvect = lambda_appvect_assum
  * error message. *)
 
 let hnf_prod_app env t n =
-  match kind_of_term (whd_betadeltaiota env t) with
+  match kind_of_term (whd_all env t) with
     | Prod (_,_,b) -> subst1 n b
     | _ -> anomaly ~label:"hnf_prod_app" (Pp.str "Need a product")
 
@@ -736,7 +742,7 @@ let hnf_prod_applist env t nl =
 
 let dest_prod env =
   let rec decrec env m c =
-    let t = whd_betadeltaiota env c in
+    let t = whd_all env c in
     match kind_of_term t with
       | Prod (n,a,c0) ->
 	  let d = LocalAssum (n,a) in
@@ -748,7 +754,7 @@ let dest_prod env =
 (* The same but preserving lets in the context, not internal ones. *)
 let dest_prod_assum env =
   let rec prodec_rec env l ty =
-    let rty = whd_betadeltaiota_nolet env ty in
+    let rty = whd_allnolet env ty in
     match kind_of_term rty with
     | Prod (x,t,c)  ->
         let d = LocalAssum (x,t) in
@@ -758,7 +764,7 @@ let dest_prod_assum env =
 	prodec_rec (push_rel d env) (Context.Rel.add d l) c
     | Cast (c,_,_)    -> prodec_rec env l c
     | _               ->
-      let rty' = whd_betadeltaiota env rty in
+      let rty' = whd_all env rty in
 	if Term.eq_constr rty' rty then l, rty
 	else prodec_rec env l rty'
   in
@@ -766,7 +772,7 @@ let dest_prod_assum env =
 
 let dest_lam_assum env =
   let rec lamec_rec env l ty =
-    let rty = whd_betadeltaiota_nolet env ty in
+    let rty = whd_allnolet env ty in
     match kind_of_term rty with
     | Lambda (x,t,c)  ->
         let d = LocalAssum (x,t) in
diff --git a/kernel/reduction.mli b/kernel/reduction.mli
index 1b5e5e32a..8a2b2469d 100644
--- a/kernel/reduction.mli
+++ b/kernel/reduction.mli
@@ -12,9 +12,11 @@ open Environ
 (***********************************************************************
   s Reduction functions *)
 
+(* None of these functions do eta reduction *)
+
 val whd_betaiotazeta        : env -> constr -> constr
-val whd_betadeltaiota       : env -> constr -> constr
-val whd_betadeltaiota_nolet : env -> constr -> constr
+val whd_all                 : env -> constr -> constr
+val whd_allnolet : env -> constr -> constr
 
 val whd_betaiota     : env -> constr -> constr
 val nf_betaiota      : env -> constr -> constr
@@ -34,7 +36,7 @@ type 'a extended_conversion_function =
 type conv_pb = CONV | CUMUL
 
 type 'a universe_compare = 
-  { (* Might raise NotConvertible *)
+  { (* Might raise NotConvertible or UnivInconsistency *)
     compare : env -> conv_pb -> sorts -> sorts -> 'a -> 'a;
     compare_instances: flex:bool -> 
 		       Univ.Instance.t -> Univ.Instance.t -> 'a -> 'a;
@@ -54,9 +56,12 @@ constructors. *)
 val convert_instances : flex:bool -> Univ.Instance.t -> Univ.Instance.t ->
   'a * 'a universe_compare -> 'a * 'a universe_compare
 
+(** These two never raise UnivInconsistency, inferred_universes
+    just gathers the constraints. *)
 val checked_universes : UGraph.t universe_compare
 val inferred_universes : (UGraph.t * Univ.Constraint.t) universe_compare
 
+(** These two functions can only raise NotConvertible *)
 val conv : constr extended_conversion_function
 
 val conv_leq : types extended_conversion_function
@@ -68,6 +73,9 @@ val infer_conv : ?l2r:bool -> ?evars:(existential->constr option) ->
 val infer_conv_leq : ?l2r:bool -> ?evars:(existential->constr option) -> 
   ?ts:Names.transparent_state -> types infer_conversion_function
 
+(** Depending on the universe state functions, this might raise
+  [UniverseInconsistency] in addition to [NotConvertible] (for better error
+  messages). *)
 val generic_conv : conv_pb -> l2r:bool -> (existential->constr option) ->
   Names.transparent_state -> (constr,'a) generic_conversion_function
 
@@ -106,3 +114,5 @@ exception NotArity
 
 val dest_arity : env -> types -> arity (* raises NotArity if not an arity *)
 val is_arity   : env -> types -> bool
+
+val warn_bytecode_compiler_failed : ?loc:Loc.t -> unit -> unit
diff --git a/kernel/safe_typing.ml b/kernel/safe_typing.ml
index ce05190b6..e4b3fcbf1 100644
--- a/kernel/safe_typing.ml
+++ b/kernel/safe_typing.ml
@@ -62,6 +62,8 @@ open Names
 open Declarations
 open Context.Named.Declaration
 
+module NamedDecl = Context.Named.Declaration
+
 (** {6 Safe environments }
 
   Fields of [safe_environment] :
@@ -180,20 +182,17 @@ let set_engagement c senv =
     env = Environ.set_engagement c senv.env;
     engagement = Some c }
 
+let set_typing_flags c senv =
+  { senv with env = Environ.set_typing_flags c senv.env }
+
 (** Check that the engagement [c] expected by a library matches
     the current (initial) one *)
-let check_engagement env (expected_impredicative_set,expected_type_in_type) =
-  let impredicative_set,type_in_type = Environ.engagement env in
+let check_engagement env expected_impredicative_set =
+  let impredicative_set = Environ.engagement env in
   begin
     match impredicative_set, expected_impredicative_set with
     | PredicativeSet, ImpredicativeSet ->
-        Errors.error "Needs option -impredicative-set."
-    | _ -> ()
-  end;
-  begin
-    match type_in_type, expected_type_in_type with
-    | StratifiedType, TypeInType ->
-        Errors.error "Needs option -type-in-type."
+        CErrors.error "Needs option -impredicative-set."
     | _ -> ()
   end
 
@@ -216,8 +215,8 @@ type private_constant_role = Term_typing.side_effect_role =
   | Schema of inductive * string
 
 let empty_private_constants = []
-let add_private x xs = x :: xs
-let concat_private xs ys = xs @ ys
+let add_private x xs = if List.mem_f Term_typing.equal_eff x xs then xs else x :: xs
+let concat_private xs ys = List.fold_right add_private xs ys
 let mk_pure_proof = Term_typing.mk_pure_proof
 let inline_private_constants_in_constr = Term_typing.inline_side_effects
 let inline_private_constants_in_definition_entry = Term_typing.inline_entry_side_effects
@@ -347,10 +346,10 @@ let check_required current_libs needed =
     try
       let actual = DPMap.find id current_libs in
       if not(digest_match ~actual ~required) then
-        Errors.error
+        CErrors.error
           ("Inconsistent assumptions over module "^(DirPath.to_string id)^".")
     with Not_found ->
-      Errors.error ("Reference to unknown module "^(DirPath.to_string id)^".")
+      CErrors.error ("Reference to unknown module "^(DirPath.to_string id)^".")
   in
   Array.iter check needed
 
@@ -364,11 +363,11 @@ let check_required current_libs needed =
     cost too much. *)
 
 let safe_push_named d env =
-  let id = get_id d in
+  let id = NamedDecl.get_id d in
   let _ =
     try
       let _ = Environ.lookup_named id env in
-      Errors.error ("Identifier "^Id.to_string id^" already defined.")
+      CErrors.error ("Identifier "^Id.to_string id^" already defined.")
     with Not_found -> () in
   Environ.push_named d env
 
@@ -797,7 +796,10 @@ type compiled_library = {
 type native_library = Nativecode.global list
 
 let get_library_native_symbols senv dir =
-  DPMap.find dir senv.native_symbols
+  try DPMap.find dir senv.native_symbols
+  with Not_found -> CErrors.user_err ~hdr:"get_library_native_symbols"
+                      Pp.((str "Linker error in the native compiler. Are you using Require inside a nested Module declaration?") ++ fnl () ++
+                          (str "This use case is not supported, but disabling the native compiler may help."))
 
 (** FIXME: MS: remove?*)
 let current_modpath senv = senv.modpath
@@ -818,8 +820,8 @@ let export ?except senv dir =
   let senv =
     try join_safe_environment ?except senv
     with e ->
-      let e = Errors.push e in
-      Errors.errorlabstrm "export" (Errors.iprint e)
+      let e = CErrors.push e in
+      CErrors.user_err ~hdr:"export" (CErrors.iprint e)
   in
   assert(senv.future_cst = []);
   let () = check_current_library dir senv in
@@ -854,6 +856,9 @@ let export ?except senv dir =
 let import lib cst vodigest senv =
   check_required senv.required lib.comp_deps;
   check_engagement senv.env lib.comp_enga;
+  if DirPath.equal (ModPath.dp senv.modpath) lib.comp_name then
+    CErrors.user_err ~hdr:"Safe_typing.import"
+     (Pp.strbrk "Cannot load a library with the same name as the current one.");
   let mp = MPfile lib.comp_name in
   let mb = lib.comp_mod in
   let env = Environ.push_context_set ~strict:true
@@ -903,7 +908,7 @@ let register_inline kn senv =
   let open Environ in
   let open Pre_env in
   if not (evaluable_constant kn senv.env) then
-    Errors.error "Register inline: an evaluable constant is expected";
+    CErrors.error "Register inline: an evaluable constant is expected";
   let env = pre_env senv.env in
   let (cb,r) = Cmap_env.find kn env.env_globals.env_constants in
   let cb = {cb with const_inline_code = true} in
diff --git a/kernel/safe_typing.mli b/kernel/safe_typing.mli
index 71dac321f..15ebc7d88 100644
--- a/kernel/safe_typing.mli
+++ b/kernel/safe_typing.mli
@@ -132,6 +132,7 @@ val add_constraints :
 
 (** Setting the type theory flavor *)
 val set_engagement : Declarations.engagement -> safe_transformer0
+val set_typing_flags : Declarations.typing_flags -> safe_transformer0
 
 (** {6 Interactive module functions } *)
 
diff --git a/kernel/subtyping.ml b/kernel/subtyping.ml
index 5efc1078e..c8ceb064d 100644
--- a/kernel/subtyping.ml
+++ b/kernel/subtyping.ml
@@ -110,7 +110,7 @@ let check_inductive cst env mp1 l info1 mp2 mib2 spec2 subst1 subst2 reso1 reso2
   in
   let u = 
     if poly then 
-      Errors.error ("Checking of subtyping of polymorphic" ^
+      CErrors.error ("Checking of subtyping of polymorphic" ^
 		       " inductive types not implemented")
     else Instance.empty
   in
@@ -347,7 +347,7 @@ let check_constant cst env mp1 l info1 cb2 spec2 subst1 subst2 =
 	      let c2 = Mod_subst.force_constr lc2 in
 	      check_conv NotConvertibleBodyField cst poly u infer_conv env' c1 c2))
    | IndType ((kn,i),mind1) ->
-       ignore (Errors.error (
+       ignore (CErrors.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 " ^
@@ -364,7 +364,7 @@ let check_constant cst env mp1 l info1 cb2 spec2 subst1 subst2 =
       let error = NotConvertibleTypeField (env, arity1, typ2) in
        check_conv error cst false Univ.Instance.empty infer_conv_leq env arity1 typ2
    | IndConstr (((kn,i),j) as cstr,mind1) ->
-      ignore (Errors.error (
+      ignore (CErrors.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 " ^
diff --git a/kernel/term.ml b/kernel/term.ml
index 4416770fe..62c161be4 100644
--- a/kernel/term.ml
+++ b/kernel/term.ml
@@ -8,7 +8,7 @@
 
 open Util
 open Pp
-open Errors
+open CErrors
 open Names
 open Vars
 
@@ -328,38 +328,9 @@ let destCoFix c = match kind_of_term c with
 let isCoFix c =  match kind_of_term c with CoFix _ -> true | _ -> false
 
 (******************************************************************)
-(* 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 throwing casts in-between *)
-let collapse_appl c = match kind_of_term c with
-  | App (f,cl) ->
-      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)
-        | _ -> mkApp (f,cl2)
-      in
-      collapse_rec f cl
-  | _ -> c
-
 let decompose_app c =
   match kind_of_term c with
     | App (f,cl) -> (f, Array.to_list cl)
@@ -465,7 +436,7 @@ let rec to_lambda n prod =
     match kind_of_term prod with
       | Prod (na,ty,bd) -> mkLambda (na,ty,to_lambda (n-1) bd)
       | Cast (c,_,_) -> to_lambda n c
-      | _   -> errorlabstrm "to_lambda" (mt ())
+      | _   -> user_err ~hdr:"to_lambda" (mt ())
 
 let rec to_prod n lam =
   if Int.equal n 0 then
@@ -474,7 +445,7 @@ let rec to_prod n lam =
     match kind_of_term lam with
       | Lambda (na,ty,bd) -> mkProd (na,ty,to_prod (n-1) bd)
       | Cast (c,_,_) -> to_prod n c
-      | _   -> errorlabstrm "to_prod" (mt ())
+      | _   -> user_err ~hdr:"to_prod" (mt ())
 
 let it_mkProd_or_LetIn   = List.fold_left (fun c d -> mkProd_or_LetIn d c)
 let it_mkLambda_or_LetIn = List.fold_left (fun c d -> mkLambda_or_LetIn d c)
diff --git a/kernel/term.mli b/kernel/term.mli
index 32267f6c4..a8d9dfbff 100644
--- a/kernel/term.mli
+++ b/kernel/term.mli
@@ -315,7 +315,7 @@ val decompose_lam_n : int -> constr -> (Name.t * constr) list * constr
    "(xi:Ti) ... (xj:=cj:Tj) ..., T" where T is not a product nor a let *)
 val decompose_prod_assum : types -> Context.Rel.t * types
 
-(** Idem with lambda's *)
+(** Idem with lambda's and let's *)
 val decompose_lam_assum : constr -> Context.Rel.t * constr
 
 (** Idem but extract the first [n] premisses, counting let-ins. *)
@@ -349,20 +349,6 @@ val strip_lam_n : int -> constr -> constr
 val strip_prod_assum : types -> types
 val strip_lam_assum : constr -> constr
 
-(** Flattens application lists *)
-val collapse_appl : constr -> constr
-
-
-(** Remove recursively the casts around a term i.e.
-   [strip_outer_cast (Cast (Cast ... (Cast c, t) ... ))] is [c]. *)
-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
-
 (** {5 ... } *)
 (** An "arity" is a term of the form [[x1:T1]...[xn:Tn]s] with [s] a sort.
     Such a term can canonically be seen as the pair of a context of types
diff --git a/kernel/term_typing.ml b/kernel/term_typing.ml
index 6bfd2457a..3a0d1a2a5 100644
--- a/kernel/term_typing.ml
+++ b/kernel/term_typing.ml
@@ -12,7 +12,7 @@
 (* This module provides the main entry points for type-checking basic
    declarations *)
 
-open Errors
+open CErrors
 open Util
 open Names
 open Term
@@ -20,7 +20,9 @@ open Declarations
 open Environ
 open Entries
 open Typeops
-open Fast_typeops
+
+module RelDecl = Context.Rel.Declaration
+module NamedDecl = Context.Named.Declaration
 
 let constrain_type env j poly subst = function
   | `None -> 
@@ -249,18 +251,17 @@ let global_vars_set_constant_type env = function
   | RegularArity t -> global_vars_set env t
   | TemplateArity (ctx,_) ->
       Context.Rel.fold_outside
-        (Context.Rel.Declaration.fold
+        (RelDecl.fold_constr
 	  (fun t c -> Id.Set.union (global_vars_set env t) c))
       ctx ~init:Id.Set.empty
 
 let record_aux env s_ty s_bo suggested_expr =
-  let open Context.Named.Declaration in
   let in_ty = keep_hyps env s_ty in
   let v =
     String.concat " "
       (CList.map_filter (fun decl ->
-          let id = get_id decl in
-          if List.exists (Id.equal id % get_id) in_ty then None
+          let id = NamedDecl.get_id decl in
+          if List.exists (NamedDecl.get_id %> Id.equal id) in_ty then None
           else Some (Id.to_string id))
         (keep_hyps env s_bo)) in
   Aux_file.record_in_aux "context_used" (v ^ ";" ^ suggested_expr)
@@ -269,26 +270,25 @@ let suggest_proof_using = ref (fun _ _ _ _ _ -> "")
 let set_suggest_proof_using f = suggest_proof_using := f
 
 let build_constant_declaration kn env (def,typ,proj,poly,univs,inline_code,ctx) =
-  let open Context.Named.Declaration in
   let check declared inferred =
-    let mk_set l = List.fold_right Id.Set.add (List.map get_id l) Id.Set.empty in
+    let mk_set l = List.fold_right Id.Set.add (List.map NamedDecl.get_id l) Id.Set.empty in
     let inferred_set, declared_set = mk_set inferred, mk_set declared in
     if not (Id.Set.subset inferred_set declared_set) then
       let l = Id.Set.elements (Idset.diff inferred_set declared_set) in
       let n = List.length l in
-      errorlabstrm "" (Pp.(str "The following section " ++
+      user_err  (Pp.(str "The following section " ++
         str (String.plural n "variable") ++
         str " " ++ str (String.conjugate_verb_to_be n) ++
         str " used but not declared:" ++
         fnl () ++ pr_sequence Id.print (List.rev l) ++ str ".")) in
   let sort evn l =
     List.filter (fun decl ->
-      let id = get_id decl in
-      List.exists (Names.Id.equal id % get_id) l)
+      let id = NamedDecl.get_id decl in
+      List.exists (NamedDecl.get_id %> Names.Id.equal id) l)
     (named_context env) in
   (* We try to postpone the computation of used section variables *)
   let hyps, def =
-    let context_ids = List.map get_id (named_context env) in
+    let context_ids = List.map NamedDecl.get_id (named_context env) in
     match ctx with
     | None when not (List.is_empty context_ids) -> 
         (* No declared section vars, and non-empty section context:
@@ -352,7 +352,9 @@ let build_constant_declaration kn env (def,typ,proj,poly,univs,inline_code,ctx)
 	    const_body_code = None;
 	    const_polymorphic = poly;
 	    const_universes = univs;
-	    const_inline_code = inline_code }
+	    const_inline_code = inline_code;
+	    const_typing_flags = Environ.typing_flags env;
+	    }
 	in
 	let env = add_constant kn cb env in
 	compile_constant_body env comp_univs def
@@ -365,7 +367,8 @@ let build_constant_declaration kn env (def,typ,proj,poly,univs,inline_code,ctx)
     const_body_code = tps;
     const_polymorphic = poly;
     const_universes = univs;
-    const_inline_code = inline_code }
+    const_inline_code = inline_code;
+    const_typing_flags = Environ.typing_flags env }
 
 (*s Global and local constant declaration. *)
 
@@ -479,8 +482,7 @@ let translate_local_def mb env id centry =
     | Undef _ -> ()
     | Def _ -> ()
     | OpaqueDef lc ->
-       let open Context.Named.Declaration in
-       let context_ids = List.map get_id (named_context env) in
+       let context_ids = List.map NamedDecl.get_id (named_context env) in
        let ids_typ = global_vars_set env typ in
        let ids_def = global_vars_set env
          (Opaqueproof.force_proof (opaque_tables env) lc) in
diff --git a/kernel/term_typing.mli b/kernel/term_typing.mli
index fcd95576c..89b5fc40e 100644
--- a/kernel/term_typing.mli
+++ b/kernel/term_typing.mli
@@ -30,6 +30,7 @@ val inline_entry_side_effects :
     yet type checked proof. *)
 
 val uniq_seff : side_effects -> side_effects
+val equal_eff : side_effect -> side_effect -> bool
 
 val translate_constant :
   structure_body -> env -> constant -> side_effects constant_entry ->
diff --git a/kernel/typeops.ml b/kernel/typeops.ml
index 0ea68e2bc..7d9a2aac0 100644
--- a/kernel/typeops.ml
+++ b/kernel/typeops.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-open Errors
+open CErrors
 open Util
 open Names
 open Univ
@@ -14,11 +14,12 @@ open Term
 open Vars
 open Declarations
 open Environ
-open Entries
 open Reduction
 open Inductive
 open Type_errors
-open Context.Rel.Declaration
+
+module RelDecl = Context.Rel.Declaration
+module NamedDecl = Context.Named.Declaration
 
 let conv_leq l2r env x y = default_conv CUMUL ~l2r env x y
 
@@ -35,61 +36,46 @@ let check_constraints cst env =
   if Environ.check_constraints cst env then ()
   else error_unsatisfied_constraints env cst
 
-(* 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 j.uj_type) with
-    | Sort s -> {utj_val = j.uj_val; utj_type = s }
-    | _ -> error_not_type env j
+(* This should be a type (a priori without intention to be an assumption) *)
+let check_type env c t =
+  match kind_of_term(whd_all env t) with
+  | Sort s -> s
+  | _ -> error_not_type env (make_judge c t)
 
-(* This should be a type intended to be assumed. The error message is *)
-(* not as useful as for [type_judgment]. *)
-let assumption_of_judgment env j =
-  try (type_judgment env j).utj_val
+(* This should be a type intended to be assumed. The error message is
+   not as useful as for [type_judgment]. *)
+let check_assumption env t ty =
+  try let _ = check_type env t ty in t
   with TypeError _ ->
-    error_assumption env j
+    error_assumption env (make_judge t ty)
 
 (************************************************)
-(* Incremental typing rules: builds a typing judgement given the *)
-(* judgements for the subterms. *)
+(* Incremental typing rules: builds a typing judgment given the *)
+(* judgments for the subterms. *)
 
 (*s Type of sorts *)
 
 (* Prop and Set *)
 
-let judge_of_prop =
-  { uj_val = mkProp;
-    uj_type = mkSort type1_sort }
-
-let judge_of_set =
-  { uj_val = mkSet;
-    uj_type = mkSort type1_sort }
-
-let judge_of_prop_contents = function
-  | Null -> judge_of_prop
-  | Pos -> judge_of_set
+let type1 = mkSort type1_sort
 
 (* Type of Type(i). *)
 
-let judge_of_type u =
+let type_of_type u =
   let uu = Universe.super u in
-    { uj_val = mkType u;
-      uj_type = mkType uu }
+    mkType uu
 
 (*s Type of a de Bruijn index. *)
 
-let judge_of_relative env n =
+let type_of_relative env n =
   try
-    let typ = get_type (lookup_rel n env) in
-    { uj_val  = mkRel n;
-      uj_type = lift n typ }
+    env |> lookup_rel n |> RelDecl.get_type |> lift n
   with Not_found ->
     error_unbound_rel env n
 
 (* Type of variables *)
-let judge_of_variable env id =
-  try
-    let ty = named_type id env in
-    make_judge (mkVar id) ty
+let type_of_variable env id =
+  try named_type id env
   with Not_found ->
     error_unbound_var env id
 
@@ -98,11 +84,11 @@ let judge_of_variable env id =
 (* Checks if a context of variables can be instantiated by the
    variables of the current env.
    Order does not have to be checked assuming that all names are distinct *)
-let check_hyps_inclusion env c sign =
+let check_hyps_inclusion env f c sign =
   Context.Named.fold_outside
     (fun d1 () ->
       let open Context.Named.Declaration in
-      let id = get_id d1 in
+      let id = NamedDecl.get_id d1 in
       try
         let d2 = lookup_named id env in
         conv env (get_type d2) (get_type d1);
@@ -114,7 +100,7 @@ let check_hyps_inclusion env c sign =
         | LocalDef _, LocalAssum _ -> raise NotConvertible
         | LocalDef (_,b2,_), LocalDef (_,b1,_) -> conv env b2 b1);
       with Not_found | NotConvertible | Option.Heterogeneous ->
-        error_reference_variables env id c)
+        error_reference_variables env id (f c))
     sign
     ~init:()
 
@@ -122,35 +108,9 @@ let check_hyps_inclusion env c sign =
 
 (* Make a type polymorphic if an arity *)
 
-let extract_level env p =
-  let _,c = dest_prod_assum env p in
-  match kind_of_term c with Sort (Type u) -> Univ.Universe.level u | _ -> None
-
-let extract_context_levels env l =
-  let fold l = function
-    | LocalAssum (_,p) -> extract_level env p :: l
-    | LocalDef _ -> l
-  in
-  List.fold_left fold [] l
-
-let make_polymorphic_if_constant_for_ind env {uj_val = c; uj_type = t} =
-  let params, ccl = dest_prod_assum env t in
-  match kind_of_term ccl with
-  | Sort (Type u) ->
-     let ind, l = decompose_app (whd_betadeltaiota env c) in
-     if isInd ind && List.is_empty l then
-       let mis = lookup_mind_specif env (fst (destInd ind)) in
-       let nparams = Inductive.inductive_params mis in
-       let paramsl = CList.lastn nparams params in
-       let param_ccls = extract_context_levels env paramsl in
-       let s = { template_param_levels = param_ccls; template_level = u} in
-       TemplateArity (params,s)
-     else RegularArity t
-  | _ ->
-      RegularArity t
-
 (* Type of constants *)
 
+
 let type_of_constant_type_knowing_parameters env t paramtyps =
   match t with
   | RegularArity t -> t
@@ -159,49 +119,28 @@ let type_of_constant_type_knowing_parameters env t paramtyps =
       let ctx,s = instantiate_universes env ctx ar paramtyps in
       mkArity (List.rev ctx,s)
 
-let type_of_constant_knowing_parameters env cst paramtyps =
-  let cb = lookup_constant (fst cst) env in
-  let () = check_hyps_inclusion env (mkConstU cst) cb.const_hyps in
+let type_of_constant_knowing_parameters env (kn,u as cst) args =
+  let cb = lookup_constant kn env in
+  let () = check_hyps_inclusion env mkConstU cst cb.const_hyps in
   let ty, cu = constant_type env cst in
-    type_of_constant_type_knowing_parameters env ty paramtyps, cu
+  let ty = type_of_constant_type_knowing_parameters env ty args in
+  let () = check_constraints cu env in
+    ty
 
-let type_of_constant_knowing_parameters_in env cst paramtyps =
-  let cb = lookup_constant (fst cst) env in
-  let () = check_hyps_inclusion env (mkConstU cst) cb.const_hyps in
+let type_of_constant_knowing_parameters_in env (kn,u as cst) args =
+  let cb = lookup_constant kn env in
+  let () = check_hyps_inclusion env mkConstU cst cb.const_hyps in
   let ty = constant_type_in env cst in
-    type_of_constant_type_knowing_parameters env ty paramtyps
-
-let type_of_constant_type env t =
-  type_of_constant_type_knowing_parameters env t [||]
+  type_of_constant_type_knowing_parameters env ty args
 
 let type_of_constant env cst =
   type_of_constant_knowing_parameters env cst [||]
 
 let type_of_constant_in env cst =
-  let cb = lookup_constant (fst cst) env in
-  let () = check_hyps_inclusion env (mkConstU cst) cb.const_hyps in
-  let ar = constant_type_in env cst in
-    type_of_constant_type_knowing_parameters env ar [||]
-
-let judge_of_constant_knowing_parameters env (kn,u as cst) args =
-  let c = mkConstU cst in
-  let ty, cu = type_of_constant_knowing_parameters env cst args in
-  let () = check_constraints cu env in
-    make_judge c ty
-
-let judge_of_constant env cst =
-  judge_of_constant_knowing_parameters env cst [||]
-
-let type_of_projection env (p,u) =
-  let cst = Projection.constant p in
-  let cb = lookup_constant cst env in
-  match cb.const_proj with
-  | Some pb -> 
-    if cb.const_polymorphic then
-      Vars.subst_instance_constr u pb.proj_type
-    else pb.proj_type
-  | None -> raise (Invalid_argument "type_of_projection: not a projection")
+  type_of_constant_knowing_parameters_in env cst [||]
 
+let type_of_constant_type env t =
+  type_of_constant_type_knowing_parameters env t [||]
 
 (* Type of a lambda-abstraction. *)
 
@@ -215,40 +154,36 @@ let type_of_projection env (p,u) =
   and no upper constraint exists on the sort $s$, we don't need to compute $s$
 *)
 
-let judge_of_abstraction env name var j =
-  { uj_val = mkLambda (name, var.utj_val, j.uj_val);
-    uj_type = mkProd (name, var.utj_val, j.uj_type) }
-
-(* Type of let-in. *)
-
-let judge_of_letin env name defj typj j =
-  { uj_val = mkLetIn (name, defj.uj_val, typj.utj_val, j.uj_val) ;
-    uj_type = subst1 defj.uj_val j.uj_type }
+let type_of_abstraction env name var ty =
+  mkProd (name, var, ty)
 
 (* Type of an application. *)
 
-let judge_of_apply env funj argjv =
-  let rec apply_rec n typ = function
-    | [] ->
-	{ uj_val  = mkApp (j_val funj, Array.map j_val argjv);
-          uj_type = typ }
-    | hj::restjl ->
-        (match kind_of_term (whd_betadeltaiota env typ) with
-          | Prod (_,c1,c2) ->
-	      (try
-		 let () = conv_leq false env hj.uj_type c1 in
-		   apply_rec (n+1) (subst1 hj.uj_val c2) restjl
-	      with NotConvertible ->
-		error_cant_apply_bad_type env
-		  (n,c1, hj.uj_type)
-		  funj argjv)
-
-          | _ ->
-	      error_cant_apply_not_functional env funj argjv)
-  in
-  apply_rec 1
-    funj.uj_type
-    (Array.to_list argjv)
+let make_judgev c t = 
+  Array.map2 make_judge c t
+
+let type_of_apply env func funt argsv argstv =
+  let len = Array.length argsv in
+  let rec apply_rec i typ = 
+    if Int.equal i len then typ
+    else 
+      (match kind_of_term (whd_all env typ) with
+      | Prod (_,c1,c2) ->
+	let arg = argsv.(i) and argt = argstv.(i) in
+	  (try
+	     let () = conv_leq false env argt c1 in
+	       apply_rec (i+1) (subst1 arg c2)
+	   with NotConvertible ->
+	     error_cant_apply_bad_type env
+	       (i+1,c1,argt)
+	       (make_judge func funt)
+	       (make_judgev argsv argstv))
+	    
+      | _ ->
+	error_cant_apply_not_functional env 
+	  (make_judge func funt)
+	  (make_judgev argsv argstv))
+  in apply_rec 0 funt
 
 (* Type of product *)
 
@@ -281,10 +216,9 @@ let sort_of_product env domsort rangsort =
 
   where j.uj_type is convertible to a sort s2
 *)
-let judge_of_product env name t1 t2 =
-  let s = sort_of_product env t1.utj_type t2.utj_type in
-  { uj_val = mkProd (name, t1.utj_val, t2.utj_val);
-    uj_type = mkSort s }
+let type_of_product env name s1 s2 =
+  let s = sort_of_product env s1 s2 in
+    mkSort s
 
 (* Type of a type cast *)
 
@@ -295,29 +229,20 @@ let judge_of_product env name t1 t2 =
          env |- c:typ2
 *)
 
-let judge_of_cast env cj k tj =
-  let expected_type = tj.utj_val in
+let check_cast env c ct k expected_type =
   try
-    let c, cst =
-      match k with
-      | VMcast ->
-          mkCast (cj.uj_val, k, expected_type),
-          Reduction.vm_conv CUMUL env cj.uj_type expected_type
-      | DEFAULTcast ->
-          mkCast (cj.uj_val, k, expected_type),
-          default_conv ~l2r:false CUMUL env cj.uj_type expected_type
-      | REVERTcast ->
-          cj.uj_val,
-          default_conv ~l2r:true CUMUL env cj.uj_type expected_type
-      | NATIVEcast ->
-	 let sigma = Nativelambda.empty_evars in
-         mkCast (cj.uj_val, k, expected_type),
-         Nativeconv.native_conv CUMUL sigma env cj.uj_type expected_type
-    in
-      { uj_val = c;
-	uj_type = expected_type }
+    match k with
+    | VMcast ->
+      vm_conv CUMUL env ct expected_type
+    | DEFAULTcast ->
+      default_conv ~l2r:false CUMUL env ct expected_type
+    | REVERTcast ->
+      default_conv ~l2r:true CUMUL env ct expected_type
+    | NATIVEcast ->
+      let sigma = Nativelambda.empty_evars in
+      Nativeconv.native_conv CUMUL sigma env ct expected_type
   with NotConvertible ->
-    error_actual_type env cj expected_type
+    error_actual_type env (make_judge c ct) expected_type
 
 (* Inductive types. *)
 
@@ -333,83 +258,78 @@ let judge_of_cast env cj k tj =
    the App case of execute; from this constraints, the expected
    dynamic constraints of the form u<=v are enforced *)
 
-let judge_of_inductive_knowing_parameters env (ind,u as indu) args =
-  let c = mkIndU indu in
+let type_of_inductive_knowing_parameters env (ind,u as indu) args =
   let (mib,mip) as spec = lookup_mind_specif env ind in
-  check_hyps_inclusion env c mib.mind_hyps;
+  check_hyps_inclusion env mkIndU indu mib.mind_hyps;
   let t,cst = Inductive.constrained_type_of_inductive_knowing_parameters 
     env (spec,u) args
   in
-    check_constraints cst env;
-    make_judge c t
+  check_constraints cst env;
+  t
 
-let judge_of_inductive env (ind,u as indu) =
-  let c = mkIndU indu in
-  let (mib,mip) as spec = lookup_mind_specif env ind in
-  check_hyps_inclusion env c mib.mind_hyps;
-  let t,cst = Inductive.constrained_type_of_inductive env (spec,u) in
-    check_constraints cst env;
-    (make_judge c t)
+let type_of_inductive env (ind,u as indu) =
+  let (mib,mip) = lookup_mind_specif env ind in
+  check_hyps_inclusion env mkIndU indu mib.mind_hyps;
+  let t,cst = Inductive.constrained_type_of_inductive env ((mib,mip),u) in
+  check_constraints cst env;
+  t
 
 (* Constructors. *)
 
-let judge_of_constructor env (c,u as cu) =
-  let constr = mkConstructU cu in
-  let _ =
+let type_of_constructor env (c,u as cu) =
+  let () =
     let ((kn,_),_) = c in
     let mib = lookup_mind kn env in
-    check_hyps_inclusion env constr mib.mind_hyps in
+    check_hyps_inclusion env mkConstructU cu mib.mind_hyps
+  in
   let specif = lookup_mind_specif env (inductive_of_constructor c) in
   let t,cst = constrained_type_of_constructor cu specif in
   let () = check_constraints cst env in
-    (make_judge constr t)
+  t
 
 (* Case. *)
 
-let check_branch_types env (ind,u) cj (lfj,explft) =
-  try conv_leq_vecti env (Array.map j_type lfj) explft
+let check_branch_types env (ind,u) c ct lft explft =
+  try conv_leq_vecti env lft explft
   with
       NotConvertibleVect i ->
-        error_ill_formed_branch env cj.uj_val ((ind,i+1),u) lfj.(i).uj_type explft.(i)
+        error_ill_formed_branch env c ((ind,i+1),u) lft.(i) explft.(i)
     | Invalid_argument _ ->
-        error_number_branches env cj (Array.length explft)
+        error_number_branches env (make_judge c ct) (Array.length explft)
 
-let judge_of_case env ci pj cj lfj =
+let type_of_case env ci p pt c ct lf lft =
   let (pind, _ as indspec) =
-    try find_rectype env cj.uj_type
-    with Not_found -> error_case_not_inductive env cj in
+    try find_rectype env ct
+    with Not_found -> error_case_not_inductive env (make_judge c ct) in
   let () = check_case_info env pind ci in
   let (bty,rslty) =
-    type_case_branches env indspec pj cj.uj_val in
-  let () = check_branch_types env pind cj (lfj,bty) in
-  ({ uj_val  = mkCase (ci, (*nf_betaiota*) pj.uj_val, cj.uj_val,
-                       Array.map j_val lfj);
-     uj_type = rslty })
+    type_case_branches env indspec (make_judge p pt) c in
+  let () = check_branch_types env pind c ct lft bty in
+  rslty
 
-let judge_of_projection env p cj =
+let type_of_projection env p c ct =
   let pb = lookup_projection p env in
   let (ind,u), args =
-    try find_rectype env cj.uj_type
-    with Not_found -> error_case_not_inductive env cj
+    try find_rectype env ct
+    with Not_found -> error_case_not_inductive env (make_judge c ct)
   in
-    assert(eq_mind pb.proj_ind (fst ind));
-    let ty = Vars.subst_instance_constr u pb.Declarations.proj_type in
-    let ty = substl (cj.uj_val :: List.rev args) ty in
-      {uj_val = mkProj (p,cj.uj_val);
-       uj_type = ty}
+  assert(eq_mind pb.proj_ind (fst ind));
+  let ty = Vars.subst_instance_constr u pb.Declarations.proj_type in
+  substl (c :: List.rev args) ty
+      
 
 (* Fixpoints. *)
 
 (* Checks the type of a general (co)fixpoint, i.e. without checking *)
 (* the specific guard condition. *)
 
-let type_fixpoint env lna lar vdefj =
-  let lt = Array.length vdefj in
+let check_fixpoint env lna lar vdef vdeft =
+  let lt = Array.length vdeft in
   assert (Int.equal (Array.length lar) lt);
   try
-    conv_leq_vecti env (Array.map j_type vdefj) (Array.map (fun ty -> lift lt ty) lar)
+    conv_leq_vecti env vdeft (Array.map (fun ty -> lift lt ty) lar)
   with NotConvertibleVect i ->
-    error_ill_typed_rec_body env i lna vdefj lar
+    error_ill_typed_rec_body env i lna (make_judgev vdef vdeft) lar
 
 (************************************************************************)
 (************************************************************************)
@@ -419,95 +339,96 @@ let type_fixpoint env lna lar vdefj =
     Ind et Constructsi un jour cela devient des constructions
     arbitraires et non plus des variables *)
 let rec execute env cstr =
+  let open Context.Rel.Declaration in
   match kind_of_term cstr with
     (* Atomic terms *)
     | Sort (Prop c) ->
-      judge_of_prop_contents c
+      type1
 	
     | Sort (Type u) ->
-      judge_of_type u
+      type_of_type u
 
     | Rel n ->
-      judge_of_relative env n
+      type_of_relative env n
 
     | Var id ->
-      judge_of_variable env id
+      type_of_variable env id
 
     | Const c ->
-      judge_of_constant env c
+      type_of_constant env c
 	
     | Proj (p, c) ->
-        let cj = execute env c in
-          judge_of_projection env p cj
+        let ct = execute env c in
+          type_of_projection env p c ct
 
     (* Lambda calculus operators *)
     | App (f,args) ->
-        let jl = execute_array env args in
-	let j =
+        let argst = execute_array env args in
+	let ft =
 	  match kind_of_term f with
-	    | Ind ind when Environ.template_polymorphic_pind ind env ->
-		(* Sort-polymorphism of inductive types *)
-	      let args = Array.map (fun j -> lazy j.uj_type) jl in
-		judge_of_inductive_knowing_parameters env ind args
-	    | Const cst when Environ.template_polymorphic_pconstant cst env ->
-		(* Sort-polymorphism of constant *)
-	      let args = Array.map (fun j -> lazy j.uj_type) jl in
-		judge_of_constant_knowing_parameters env cst args
-	    | _ ->
-		(* No sort-polymorphism *)
-		execute env f
+	  | Ind ind when Environ.template_polymorphic_pind ind env ->
+	      (* Template sort-polymorphism of inductive types *)
+	    let args = Array.map (fun t -> lazy t) argst in
+              type_of_inductive_knowing_parameters env ind args
+	  | Const cst when Environ.template_polymorphic_pconstant cst env ->
+	      (* Template sort-polymorphism of constants *)
+	    let args = Array.map (fun t -> lazy t) argst in
+              type_of_constant_knowing_parameters env cst args
+	  | _ ->
+	    (* Full or no sort-polymorphism *)
+            execute env f
 	in
-	  judge_of_apply env j jl
+
+          type_of_apply env f ft args argst
 
     | Lambda (name,c1,c2) ->
-      let varj = execute_type env c1 in
-      let env1 = push_rel (LocalAssum (name,varj.utj_val)) env in
-      let j' = execute env1 c2 in
-        judge_of_abstraction env name varj j'
+      let _ = execute_is_type env c1 in
+      let env1 = push_rel (LocalAssum (name,c1)) env in
+      let c2t = execute env1 c2 in
+        type_of_abstraction env name c1 c2t
 
     | Prod (name,c1,c2) ->
-      let varj = execute_type env c1 in
-      let env1 = push_rel (LocalAssum (name,varj.utj_val)) env in
-      let varj' = execute_type env1 c2 in
-	judge_of_product env name varj varj'
+      let vars = execute_is_type env c1 in
+      let env1 = push_rel (LocalAssum (name,c1)) env in
+      let vars' = execute_is_type env1 c2 in
+        type_of_product env name vars vars'
 
     | LetIn (name,c1,c2,c3) ->
-      let j1 = execute env c1 in
-      let j2 = execute_type env c2 in
-      let _ = judge_of_cast env j1 DEFAULTcast j2 in
-      let env1 = push_rel (LocalDef (name,j1.uj_val,j2.utj_val)) env in
-      let j' = execute env1 c3 in
-        judge_of_letin env name j1 j2 j'
+      let c1t = execute env c1 in
+      let _c2s = execute_is_type env c2 in
+      let () = check_cast env c1 c1t DEFAULTcast c2 in
+      let env1 = push_rel (LocalDef (name,c1,c2)) env in
+      let c3t = execute env1 c3 in
+	subst1 c1 c3t
 
     | Cast (c,k,t) ->
-      let cj = execute env c in
-      let tj = execute_type env t in
-        judge_of_cast env cj k tj
+      let ct = execute env c in
+      let _ts = (check_type env t (execute env t)) in
+      let () = check_cast env c ct k t in
+	t
 
     (* Inductive types *)
     | Ind ind ->
-      judge_of_inductive env ind
+      type_of_inductive env ind
 
     | Construct c ->
-      judge_of_constructor env c
+      type_of_constructor env c
 
     | Case (ci,p,c,lf) ->
-        let cj = execute env c in
-        let pj = execute env p in
-        let lfj = execute_array env lf in
-          judge_of_case env ci pj cj lfj
+        let ct = execute env c in
+        let pt = execute env p in
+        let lft = execute_array env lf in
+          type_of_case env ci p pt c ct lf lft
 
     | Fix ((vn,i as vni),recdef) ->
       let (fix_ty,recdef') = execute_recdef env recdef i in
       let fix = (vni,recdef') in
-        check_fix env fix;
-	make_judge (mkFix fix) fix_ty
+        check_fix env fix; fix_ty
 	  
     | CoFix (i,recdef) ->
       let (fix_ty,recdef') = execute_recdef env recdef i in
       let cofix = (i,recdef') in
-        check_cofix env cofix;
-	(make_judge (mkCoFix cofix) fix_ty)
+        check_cofix env cofix; fix_ty
 	  
     (* Partial proofs: unsupported by the kernel *)
     | Meta _ ->
@@ -516,53 +437,158 @@ let rec execute env cstr =
     | Evar _ ->
 	anomaly (Pp.str "the kernel does not support existential variables")
 
-and execute_type env constr =
-  let j = execute env constr in
-    type_judgment env j
+and execute_is_type env constr =
+  let t = execute env constr in
+    check_type env constr t
 
 and execute_recdef env (names,lar,vdef) i =
-  let larj = execute_array env lar in
-  let lara = Array.map (assumption_of_judgment env) larj in
+  let lart = execute_array env lar in
+  let lara = Array.map2 (check_assumption env) lar lart in
   let env1 = push_rec_types (names,lara,vdef) env in
-  let vdefj = execute_array env1 vdef in
-  let vdefv = Array.map j_val vdefj in
-  let () = type_fixpoint env1 names lara vdefj in
-    (lara.(i),(names,lara,vdefv))
+  let vdeft = execute_array env1 vdef in
+  let () = check_fixpoint env1 names lara vdef vdeft in
+    (lara.(i),(names,lara,vdef))
 
 and execute_array env = Array.map (execute env)
 
 (* Derived functions *)
 let infer env constr =
-  let j = execute env constr in
-    assert (eq_constr j.uj_val constr);
-    j
+  let t = execute env constr in
+    make_judge constr t
+
+let infer = 
+  if Flags.profile then
+    let infer_key = Profile.declare_profile "Fast_infer" in
+      Profile.profile2 infer_key (fun b c -> infer b c)
+  else (fun b c -> infer b c)
+
+let assumption_of_judgment env {uj_val=c; uj_type=t} =
+  check_assumption env c t
 
-(* let infer_key = Profile.declare_profile "infer" *)
-(* let infer = Profile.profile2 infer_key infer *)
+let type_judgment env {uj_val=c; uj_type=t} =
+  let s = check_type env c t in
+  {utj_val = c; utj_type = s }
 
 let infer_type env constr =
-  let j = execute_type env constr in
-    j
+  let t = execute env constr in
+  let s = check_type env constr t in
+  {utj_val = constr; utj_type = s}
 
 let infer_v env cv =
   let jv = execute_array env cv in
-    jv
+    make_judgev cv jv
 
 (* Typing of several terms. *)
 
 let infer_local_decl env id = function
-  | LocalDefEntry c ->
-      let j = infer env c in
-      LocalDef (Name id, j.uj_val, j.uj_type)
-  | LocalAssumEntry c ->
-      let j = infer env c in
-      LocalAssum (Name id, assumption_of_judgment env j)
+  | Entries.LocalDefEntry c ->
+      let t = execute env c in
+      RelDecl.LocalDef (Name id, c, t)
+  | Entries.LocalAssumEntry c ->
+      let t = execute env c in
+      RelDecl.LocalAssum (Name id, check_assumption env c t)
 
 let infer_local_decls env decls =
   let rec inferec env = function
   | (id, d) :: l ->
       let (env, l) = inferec env l in
       let d = infer_local_decl env id d in
-	(push_rel d env, Context.Rel.add d l)
-  | [] -> (env, Context.Rel.empty) in
+        (push_rel d env, Context.Rel.add d l)
+  | [] -> (env, Context.Rel.empty)
+  in
   inferec env decls
+
+let judge_of_prop = make_judge mkProp type1
+let judge_of_set = make_judge mkSet type1
+let judge_of_type u = make_judge (mkType u) (type_of_type u)
+
+let judge_of_prop_contents = function
+  | Null -> judge_of_prop
+  | Pos -> judge_of_set
+
+let judge_of_relative env k = make_judge (mkRel k) (type_of_relative env k)
+
+let judge_of_variable env x = make_judge (mkVar x) (type_of_variable env x)
+
+let judge_of_constant env cst = make_judge (mkConstU cst) (type_of_constant env cst)
+let judge_of_constant_knowing_parameters env cst args =
+  make_judge (mkConstU cst) (type_of_constant_knowing_parameters env cst args)
+
+let judge_of_projection env p cj =
+  make_judge (mkProj (p,cj.uj_val)) (type_of_projection env p cj.uj_val cj.uj_type)
+
+let dest_judgev v =
+  Array.map j_val v, Array.map j_type v
+
+let judge_of_apply env funj argjv =
+  let args, argtys = dest_judgev argjv in
+  make_judge (mkApp (funj.uj_val, args)) (type_of_apply env funj.uj_val funj.uj_type args argtys)
+
+let judge_of_abstraction env x varj bodyj =
+  make_judge (mkLambda (x, varj.utj_val, bodyj.uj_val))
+             (type_of_abstraction env x varj.utj_val bodyj.uj_type)
+
+let judge_of_product env x varj outj =
+  make_judge (mkProd (x, varj.utj_val, outj.utj_val))
+             (mkSort (sort_of_product env varj.utj_type outj.utj_type))
+
+let judge_of_letin env name defj typj j =
+  make_judge (mkLetIn (name, defj.uj_val, typj.utj_val, j.uj_val))
+             (subst1 defj.uj_val j.uj_type)
+
+let judge_of_cast env cj k tj =
+  let () = check_cast env cj.uj_val cj.uj_type k tj.utj_val in
+  let c = match k with | REVERTcast -> cj.uj_val | _ -> mkCast (cj.uj_val, k, tj.utj_val) in
+  make_judge c tj.utj_val
+
+let judge_of_inductive env indu =
+  make_judge (mkIndU indu) (type_of_inductive env indu)
+
+let judge_of_constructor env cu =
+  make_judge (mkConstructU cu) (type_of_constructor env cu)
+
+let judge_of_case env ci pj cj lfj =
+  let lf, lft = dest_judgev lfj in
+  make_judge (mkCase (ci, (*nf_betaiota*) pj.uj_val, cj.uj_val, lft))
+             (type_of_case env ci pj.uj_val pj.uj_type cj.uj_val cj.uj_type lf lft)
+
+let type_of_projection_constant env (p,u) =
+  let cst = Projection.constant p in
+  let cb = lookup_constant cst env in
+  match cb.const_proj with
+  | Some pb ->
+    if cb.const_polymorphic then
+      Vars.subst_instance_constr u pb.proj_type
+    else pb.proj_type
+  | None -> raise (Invalid_argument "type_of_projection: not a projection")
+
+(* Instantiation of terms on real arguments. *)
+
+(* Make a type polymorphic if an arity *)
+
+let extract_level env p =
+  let _,c = dest_prod_assum env p in
+  match kind_of_term c with Sort (Type u) -> Univ.Universe.level u | _ -> None
+
+let extract_context_levels env l =
+  let fold l = function
+    | RelDecl.LocalAssum (_,p) -> extract_level env p :: l
+    | RelDecl.LocalDef _ -> l
+  in
+  List.fold_left fold [] l
+
+let make_polymorphic_if_constant_for_ind env {uj_val = c; uj_type = t} =
+  let params, ccl = dest_prod_assum env t in
+  match kind_of_term ccl with
+  | Sort (Type u) ->
+     let ind, l = decompose_app (whd_all env c) in
+     if isInd ind && List.is_empty l then
+       let mis = lookup_mind_specif env (fst (destInd ind)) in
+       let nparams = Inductive.inductive_params mis in
+       let paramsl = CList.lastn nparams params in
+       let param_ccls = extract_context_levels env paramsl in
+       let s = { template_param_levels = param_ccls; template_level = u} in
+       TemplateArity (params,s)
+     else RegularArity t
+  | _ ->
+      RegularArity t
diff --git a/kernel/typeops.mli b/kernel/typeops.mli
index 2112284ea..007acae60 100644
--- a/kernel/typeops.mli
+++ b/kernel/typeops.mli
@@ -15,7 +15,7 @@ open Declarations
 
 (** {6 Typing functions (not yet tagged as safe) }
 
-    They return unsafe judgments that are "in context" of a set of 
+    They return unsafe judgments that are "in context" of a set of
     (local) universe variables (the ones that appear in the term)
     and associated constraints. In case of polymorphic definitions,
     these variables and constraints will be generalized.
@@ -91,9 +91,6 @@ val judge_of_cast :
 
 val judge_of_inductive : env -> inductive puniverses -> unsafe_judgment
 
-(* val judge_of_inductive_knowing_parameters : *)
-(*   env -> inductive -> unsafe_judgment array -> unsafe_judgment *)
-
 val judge_of_constructor : env -> constructor puniverses -> unsafe_judgment
 
 (** {6 Type of Cases. } *)
@@ -101,24 +98,15 @@ val judge_of_case : env -> case_info
   -> unsafe_judgment -> unsafe_judgment -> unsafe_judgment array
     -> unsafe_judgment
 
-(** Typecheck general fixpoint (not checking guard conditions) *)
-val type_fixpoint : env -> Name.t array -> types array
-    -> unsafe_judgment array -> unit
-
-val type_of_constant : env -> pconstant -> types constrained
-
 val type_of_constant_type : env -> constant_type -> types
 
-val type_of_projection : env -> Names.projection puniverses -> types
+val type_of_projection_constant : env -> Names.projection puniverses -> types
 
 val type_of_constant_in : env -> pconstant -> types
 
 val type_of_constant_type_knowing_parameters :
   env -> constant_type -> types Lazy.t array -> types
 
-val type_of_constant_knowing_parameters :
-  env -> pconstant -> types Lazy.t array -> types constrained
-
 val type_of_constant_knowing_parameters_in :
   env -> pconstant -> types Lazy.t array -> types
 
@@ -127,4 +115,4 @@ val make_polymorphic_if_constant_for_ind : env -> unsafe_judgment ->
   constant_type
 
 (** Check that hyps are included in env and fails with error otherwise *)
-val check_hyps_inclusion : env -> constr -> Context.section_context -> unit
+val check_hyps_inclusion : env -> ('a -> constr) -> 'a -> Context.Named.t -> unit
diff --git a/kernel/uGraph.ml b/kernel/uGraph.ml
index 00883ddd8..4884d0deb 100644
--- a/kernel/uGraph.ml
+++ b/kernel/uGraph.ml
@@ -7,7 +7,6 @@
 (************************************************************************)
 
 open Pp
-open Errors
 open Util
 open Univ
 
@@ -132,7 +131,7 @@ let change_node g n =
 let rec repr g u =
   let a =
     try UMap.find u g.entries
-    with Not_found -> anomaly ~label:"Univ.repr"
+    with Not_found -> CErrors.anomaly ~label:"Univ.repr"
         (str"Universe " ++ Level.pr u ++ str" undefined")
   in
   match a with
@@ -639,19 +638,6 @@ let check_smaller g strict u v =
 
 type 'a check_function = universes -> 'a -> 'a -> bool
 
-let check_equal_expr g x y =
-  x == y || (let (u, n) = x and (v, m) = y in 
-               Int.equal n m && check_equal g u v)
-
-let check_eq_univs g l1 l2 =
-  let f x1 x2 = check_equal_expr g x1 x2 in
-  let exists x1 l = Universe.exists (fun x2 -> f x1 x2) l in
-    Universe.for_all (fun x1 -> exists x1 l2) l1
-    && Universe.for_all (fun x2 -> exists x2 l1) l2
-
-let check_eq g u v =
-  Universe.equal u v || check_eq_univs g u v
-
 let check_smaller_expr g (u,n) (v,m) =
   let diff = n - m in
     match diff with
@@ -670,7 +656,13 @@ let real_check_leq g u v =
 let check_leq g u v =
   Universe.equal u v ||
     is_type0m_univ u ||
-    check_eq_univs g u v || real_check_leq g u v
+    real_check_leq g u v
+
+let check_eq_univs g l1 l2 =
+  real_check_leq g l1 l2 && real_check_leq g l2 l1
+
+let check_eq g u v =
+  Universe.equal u v || check_eq_univs g u v
 
 (* enforce_univ_eq g u v will force u=v if possible, will fail otherwise *)
 
diff --git a/kernel/univ.ml b/kernel/univ.ml
index 126f95f1f..09f884ecd 100644
--- a/kernel/univ.ml
+++ b/kernel/univ.ml
@@ -16,7 +16,7 @@
    Sozeau, Pierre-Marie Pédrot *)
 
 open Pp
-open Errors
+open CErrors
 open Util
 
 (* Universes are stratified by a partial ordering $\le$.
@@ -468,15 +468,32 @@ struct
       else if Level.is_prop u then
 	hcons (Level.set,n+k)
       else hcons (u,n+k)
-	
+
+    type super_result =
+	SuperSame of bool
+        (* The level expressions are in cumulativity relation. boolean
+           indicates if left is smaller than right?  *)
+      | SuperDiff of int
+        (* The level expressions are unrelated, the comparison result
+           is canonical *)
+
+    (** [super u v] compares two level expressions,
+       returning [SuperSame] if they refer to the same level at potentially different
+       increments or [SuperDiff] if they are different. The booleans indicate if the
+       left expression is "smaller" than the right one in both cases. *)
     let super (u,n as x) (v,n' as y) =
       let cmp = Level.compare u v in
-	if Int.equal cmp 0 then 
-	  if n < n' then Inl true
-	  else Inl false
-	else if is_prop x then Inl true
-	else if is_prop y then Inl false
-	else Inr cmp
+	if Int.equal cmp 0 then SuperSame (n < n')
+	else
+	  match x, y with
+	  | (l,0), (l',0) ->
+	     let open RawLevel in
+	     (match Level.data l, Level.data l' with
+	      | Prop, Prop -> SuperSame false
+	      | Prop, _ -> SuperSame true
+	      | _, Prop -> SuperSame false
+	      | _, _ -> SuperDiff cmp)
+	  | _, _ -> SuperDiff cmp
 
     let to_string (v, n) =
       if Int.equal n 0 then Level.to_string v
@@ -598,24 +615,26 @@ struct
     | Nil, _ -> l2
     | _, Nil -> l1
     | Cons (h1, _, t1), Cons (h2, _, t2) ->
-      (match Expr.super h1 h2 with
-      | Inl true (* h1 < h2 *) -> merge_univs t1 l2
-      | Inl false -> merge_univs l1 t2
-      | Inr c -> 
-        if c <= 0 (* h1 < h2 is name order *)
-	then cons h1 (merge_univs t1 l2)
-	else cons h2 (merge_univs l1 t2))
+       let open Expr in
+       (match super h1 h2 with
+	| SuperSame true (* h1 < h2 *) -> merge_univs t1 l2
+	| SuperSame false -> merge_univs l1 t2
+	| SuperDiff c ->
+           if c <= 0 (* h1 < h2 is name order *)
+	   then cons h1 (merge_univs t1 l2)
+	   else cons h2 (merge_univs l1 t2))
 
   let sort u =
     let rec aux a l = 
       match l with
       | Cons (b, _, l') ->
-        (match Expr.super a b with
-	| Inl false -> aux a l'
-	| Inl true -> l
-	| Inr c ->
-	  if c <= 0 then cons a l
-	  else cons b (aux a l'))
+	let open Expr in
+        (match super a b with
+	 | SuperSame false -> aux a l'
+	 | SuperSame true -> l
+	 | SuperDiff c ->
+	    if c <= 0 then cons a l
+	    else cons b (aux a l'))
       | Nil -> cons a l
     in 
       fold (fun a acc -> aux a acc) u nil
diff --git a/kernel/vars.ml b/kernel/vars.ml
index b935ab6b9..4affb5f9f 100644
--- a/kernel/vars.ml
+++ b/kernel/vars.ml
@@ -8,7 +8,8 @@
 
 open Names
 open Esubst
-open Context.Rel.Declaration
+
+module RelDecl = Context.Rel.Declaration
 
 (*********************)
 (*     Occurring     *)
@@ -160,25 +161,35 @@ let substnl laml n c = substn_many (make_subst laml) n c
 let substl laml c = substn_many (make_subst laml) 0 c
 let subst1 lam c = substn_many [|make_substituend lam|] 0 c
 
-let substnl_decl laml k r = map_constr (fun c -> substnl laml k c) r
-let substl_decl laml r = map_constr (fun c -> substnl laml 0 c) r
-let subst1_decl lam r = map_constr (fun c -> subst1 lam c) r
+let substnl_decl laml k r = RelDecl.map_constr (fun c -> substnl laml k c) r
+let substl_decl laml r = RelDecl.map_constr (fun c -> substnl laml 0 c) r
+let subst1_decl lam r = RelDecl.map_constr (fun c -> subst1 lam c) r
 
 (* Build a substitution from an instance, inserting missing let-ins *)
 
 let subst_of_rel_context_instance sign l =
   let rec aux subst sign l =
+    let open RelDecl in
     match sign, l with
     | LocalAssum _ :: sign', a::args' -> aux (a::subst) sign' args'
     | LocalDef (_,c,_)::sign', args' ->
 	aux (substl subst c :: subst) sign' args'
     | [], [] -> subst
-    | _ -> Errors.anomaly (Pp.str "Instance and signature do not match")
+    | _ -> CErrors.anomaly (Pp.str "Instance and signature do not match")
   in aux [] (List.rev sign) l
 
 let adjust_subst_to_rel_context sign l =
   List.rev (subst_of_rel_context_instance sign l)
 
+let adjust_rel_to_rel_context sign n =
+  let rec aux sign =
+    let open RelDecl in
+    match sign with
+    | LocalAssum _ :: sign' -> let (n',p) = aux sign' in (n'+1,p)
+    | LocalDef (_,c,_)::sign' -> let (n',p) = aux sign' in (n'+1,if n'<n then p+1 else p)
+    | [] -> (0,n)
+  in snd (aux sign)
+
 (* (thin_val sigma) removes identity substitutions from sigma *)
 
 let rec thin_val = function
diff --git a/kernel/vars.mli b/kernel/vars.mli
index 574d50ecc..f7535e6d8 100644
--- a/kernel/vars.mli
+++ b/kernel/vars.mli
@@ -73,6 +73,10 @@ val subst_of_rel_context_instance : Context.Rel.t -> constr list -> substl
 (** For compatibility: returns the substitution reversed *)
 val adjust_subst_to_rel_context : Context.Rel.t -> constr list -> constr list
 
+(** Take an index in an instance of a context and returns its index wrt to
+    the full context (e.g. 2 in [x:A;y:=b;z:C] is 3, i.e. a reference to z) *)
+val adjust_rel_to_rel_context : Context.Rel.t -> int -> int
+
 (** [substnl [a₁;...;an] k c] substitutes in parallel [a₁],...,[an]
     for respectively [Rel(k+1)],...,[Rel(k+n)] in [c]; it relocates
     accordingly indexes in [an],...,[a1] and [c]. In terms of typing, if
diff --git a/kernel/vconv.ml b/kernel/vconv.ml
index 53db6f5be..74d956bef 100644
--- a/kernel/vconv.ml
+++ b/kernel/vconv.ml
@@ -77,6 +77,7 @@ and conv_whd env pb k whd1 whd2 cu =
   | Vatom_stk(a1,stk1), Vatom_stk(a2,stk2) ->
       conv_atom env pb k a1 stk1 a2 stk2 cu
   | Vfun _, _ | _, Vfun _ ->
+     (* on the fly eta expansion *)
       conv_val env CONV (k+1) (apply_whd k whd1) (apply_whd k whd2) cu
 
   | Vsort _, _ | Vprod _, _ | Vfix _, _ | Vcofix _, _  | Vconstr_const _, _
@@ -116,14 +117,14 @@ and conv_atom env pb k a1 stk1 a2 stk2 cu =
   | Atype _ , _ | _, Atype _ -> assert false
   | Aind _, _ | Aid _, _ -> raise NotConvertible
 
-and conv_stack env ?from:(from=0) k stk1 stk2 cu =
+and conv_stack env k stk1 stk2 cu =
   match stk1, stk2 with
   | [], [] -> cu
   | Zapp args1 :: stk1, Zapp args2 :: stk2 ->
-      conv_stack env k stk1 stk2 (conv_arguments env ~from:from k args1 args2 cu)
+      conv_stack env k stk1 stk2 (conv_arguments env k args1 args2 cu)
   | Zfix(f1,args1) :: stk1, Zfix(f2,args2) :: stk2 ->
       conv_stack env k stk1 stk2
-	(conv_arguments env ~from:from k args1 args2 (conv_fix env k f1 f2 cu))
+	(conv_arguments env k args1 args2 (conv_fix env k f1 f2 cu))
   | Zswitch sw1 :: stk1, Zswitch sw2 :: stk2 ->
       if check_switch sw1 sw2 then
 	let vt1,vt2 = type_of_switch sw1, type_of_switch sw2 in
@@ -185,10 +186,9 @@ let vm_conv_gen cv_pb env univs t1 t2 =
     let v2 = val_of_constr env t2 in
     fst (conv_val env cv_pb (nb_rel env) v1 v2 univs)
   with Not_found | Invalid_argument _ ->
-    (Feedback.msg_warning
-      (Pp.str "Bytecode compilation failed, falling back to default conversion");
-     Reduction.generic_conv cv_pb ~l2r:false (fun _ -> None)
-			    full_transparent_state env univs t1 t2)
+    warn_bytecode_compiler_failed ();
+    Reduction.generic_conv cv_pb ~l2r:false (fun _ -> None)
+      full_transparent_state env univs t1 t2
 
 let vm_conv cv_pb env t1 t2 =
   let univs = Environ.universes env in
diff --git a/kernel/vm.ml b/kernel/vm.ml
index 702987643..53483a222 100644
--- a/kernel/vm.ml
+++ b/kernel/vm.ml
@@ -170,7 +170,7 @@ type whd =
 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"
+external push_vstack : vstack -> int -> unit = "coq_push_vstack"
 
 
 (* interpreteur *)
@@ -206,7 +206,9 @@ let apply_varray vf varray =
   else
     begin
       push_ra stop;
-      push_vstack varray;
+      (* The fun code of [vf] will make sure we have enough stack, so we put 0
+         here. *)
+      push_vstack varray 0;
       interprete (fun_code vf) vf (Obj.magic vf) (n - 1)
     end
 
@@ -232,7 +234,7 @@ let uni_lvl_val (v : values) : Univ.universe_level =
         | Vatom_stk (a,stk) -> str "Vatom_stk"
         | _ -> assert false
       in
-      Errors.anomaly
+      CErrors.anomaly
         Pp.(   strbrk "Parsing virtual machine value expected universe level, got "
             ++ pr)
 
@@ -282,7 +284,7 @@ let rec whd_accu a stk =
       | _           -> assert false
       end
   | tg ->
-    Errors.anomaly
+    CErrors.anomaly
       Pp.(strbrk "Failed to parse VM value. Tag = " ++ int tg)
 
 external kind_of_closure : Obj.t -> int = "coq_kind_of_closure"
@@ -306,7 +308,7 @@ let whd_val : values -> whd =
 	   | 1 -> Vfix(Obj.obj o, None)
 	   | 2 -> Vfix(Obj.obj (Obj.field o 1), Some (Obj.obj o))
 	   | 3 -> Vatom_stk(Aid(RelKey(int_tcode (fun_code o) 1)), [])
-	   | _ -> Errors.anomaly ~label:"Vm.whd " (Pp.str "kind_of_closure does not work"))
+	   | _ -> CErrors.anomaly ~label:"Vm.whd " (Pp.str "kind_of_closure does not work"))
 	else
            Vconstr_block(Obj.obj o)
 
@@ -560,7 +562,9 @@ let check_switch 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;
+  (* The fun code of types will make sure we have enough stack, so we put 0
+  here. *)
+  push_vstack sw.sw_stk 0;
   interprete sw.sw_type_code crazy_val sw.sw_env 0
 
 let branch_arg k (tag,arity) =
@@ -580,9 +584,10 @@ let branch_arg k (tag,arity) =
 let apply_switch sw arg =
   let tc = sw.sw_annot.tailcall in
   if tc then
-    (push_ra stop;push_vstack sw.sw_stk)
+    (push_ra stop;push_vstack sw.sw_stk sw.sw_annot.max_stack_size)
   else
-    (push_vstack sw.sw_stk; push_ra (popstop_code (Array.length sw.sw_stk)));
+    (push_vstack sw.sw_stk sw.sw_annot.max_stack_size;
+     push_ra (popstop_code (Array.length sw.sw_stk)));
   interprete sw.sw_code arg sw.sw_env 0
 
 let branch_of_switch k sw =
diff --git a/lib/aux_file.ml b/lib/aux_file.ml
index d06d4b376..1b6651a55 100644
--- a/lib/aux_file.ml
+++ b/lib/aux_file.ml
@@ -25,9 +25,9 @@ let mk_absolute vfile =
   if Filename.is_relative vfile then CUnix.correct_path vfile (Sys.getcwd ())
   else vfile
 
-let start_aux_file_for vfile =
-  let vfile = mk_absolute vfile in
-  oc := Some (open_out (aux_file_name_for vfile));
+let start_aux_file ~aux_file:output_file ~v_file =
+  let vfile = mk_absolute v_file in
+  oc := Some (open_out output_file);
   Printf.fprintf (Option.get !oc) "COQAUX%d %s %s\n"
     version (Digest.to_hex (Digest.file vfile)) vfile
 
@@ -72,14 +72,15 @@ let load_aux_file_for vfile =
   let add loc k v = h := set !h loc k v in
   let aux_fname = aux_file_name_for vfile in
   try
-    let ic = open_in aux_fname in
-    let ver, hash, fname = Scanf.fscanf ic "COQAUX%d %s %s\n" ret3 in
+    let ib = Scanf.Scanning.from_channel (open_in aux_fname) in
+    let ver, hash, fname =
+      Scanf.bscanf ib "COQAUX%d %s %s\n" ret3 in
     if ver <> version then raise (Failure "aux file version mismatch");
     if fname <> vfile then
       raise (Failure "aux file name mismatch");
     let only_dummyloc = Digest.to_hex (Digest.file vfile) <> hash in
     while true do
-      let i, j, k, v = Scanf.fscanf ic "%d %d %s %S\n" ret4 in
+      let i, j, k, v = Scanf.bscanf ib "%d %d %s %S\n" ret4 in
       if not only_dummyloc || (i = 0 && j = 0) then add (i,j) k v;
     done;
     raise End_of_file
@@ -87,8 +88,7 @@ let load_aux_file_for vfile =
   | End_of_file -> !h
   | Sys_error s | Scanf.Scan_failure s
   | Failure s | Invalid_argument s ->
-     Flags.if_verbose
-       Feedback.msg_warning Pp.(str"Loading file "++str aux_fname++str": "++str s);
+    Flags.if_verbose Feedback.msg_info Pp.(str"Loading file "++str aux_fname++str": "++str s);
      empty_aux_file
 
 let set h loc k v = set h (Loc.unloc loc) k v
diff --git a/lib/aux_file.mli b/lib/aux_file.mli
index 127827ab6..86e322b71 100644
--- a/lib/aux_file.mli
+++ b/lib/aux_file.mli
@@ -17,7 +17,8 @@ module H : Map.S with type key = int * int
 module M : Map.S with type key = string
 val contents : aux_file -> string M.t H.t
 
-val start_aux_file_for : string -> unit
+val aux_file_name_for : string -> string
+val start_aux_file : aux_file:string -> v_file:string -> unit
 val stop_aux_file : unit -> unit 
 val recording : unit -> bool
 
diff --git a/lib/errors.ml b/lib/cErrors.ml
index 8982dde14..dbebe6a48 100644
--- a/lib/errors.ml
+++ b/lib/cErrors.ml
@@ -16,6 +16,16 @@ let push = Backtrace.add_backtrace
 
 exception Anomaly of string option * std_ppcmds (* System errors *)
 
+(* XXX: To move to common tagging functions in Pp, blocked on tag
+ * system cleanup as we cannot define generic error tags now.
+ *
+ * Anyways, tagging should not happen here, but in the specific
+ * listener to the msg_* stuff.
+ *)
+let tag_err_str s = tag Ppstyle.(Tag.inj error_tag tag) (str s) ++ spc ()
+let err_str       = tag_err_str "Error:"
+let ann_str       = tag_err_str "Anomaly:"
+
 let _ =
   let pr = function
   | Anomaly (s, pp) -> Some ("\"Anomaly: " ^ string_of_ppcmds pp ^ "\"")
@@ -26,25 +36,24 @@ let _ =
 let make_anomaly ?label pp =
   Anomaly (label, pp)
 
-let anomaly ?loc ?label pp = match loc with
-  | None -> raise (Anomaly (label, pp))
-  | Some loc -> Loc.raise loc (Anomaly (label, pp))
+let anomaly ?loc ?label pp =
+  Loc.raise ?loc (Anomaly (label, pp))
 
 let is_anomaly = function
 | Anomaly _ -> true
 | _ -> false
 
-exception UserError of string * std_ppcmds (* User errors *)
-let error string = raise (UserError("_", str string))
-let errorlabstrm l pps = raise (UserError(l,pps))
-
-exception AlreadyDeclared of std_ppcmds (* for already declared Schemes *)
-let alreadydeclared pps = raise (AlreadyDeclared(pps))
+exception UserError of string option * std_ppcmds (* User errors *)
 
 let todo s = prerr_string ("TODO: "^s^"\n")
 
-let user_err_loc (loc,s,strm) = Loc.raise loc (UserError (s,strm))
-let invalid_arg_loc (loc,s) = Loc.raise loc (Invalid_argument s)
+let user_err ?loc ?hdr strm = Loc.raise ?loc (UserError (hdr, strm))
+let error            string = user_err (str string)
+
+let invalid_arg ?loc s   = Loc.raise ?loc (Invalid_argument s)
+
+exception AlreadyDeclared of std_ppcmds (* for already declared Schemes *)
+let alreadydeclared pps = raise (AlreadyDeclared(pps))
 
 exception Timeout
 exception Drop
@@ -93,7 +102,9 @@ let print_backtrace e = match Backtrace.get_backtrace e with
 
 let print_anomaly askreport e =
   if askreport then
-    hov 0 (str "Anomaly: " ++ raw_anomaly e ++ spc () ++ str "Please report.")
+    hov 0 (ann_str ++ raw_anomaly e ++ spc () ++
+           strbrk "Please report at " ++ str Coq_config.wwwbugtracker ++
+           str ".")
   else
     hov 0 (raw_anomaly e)
 
@@ -113,7 +124,7 @@ let iprint_no_report (e, info) =
 
 let _ = register_handler begin function
   | UserError(s, pps) ->
-    hov 0 (str "Error: " ++ where (Some s) ++ pps)
+    hov 0 (err_str ++ where s ++ pps)
   | _ -> raise Unhandled
 end
 
@@ -144,5 +155,5 @@ let handled e =
 let fatal_error info anomaly =
   let msg = info ++ fnl () in
   pp_with ~pp_tag:Ppstyle.pp_tag !Pp_control.err_ft msg;
-  flush_all ();
+  Format.pp_print_flush !Pp_control.err_ft ();
   exit (if anomaly then 129 else 1)
diff --git a/lib/errors.mli b/lib/cErrors.mli
index e5dad93fd..5cffc725d 100644
--- a/lib/errors.mli
+++ b/lib/cErrors.mli
@@ -33,15 +33,21 @@ val is_anomaly : exn -> bool
     This is mostly provided for compatibility. Please avoid doing specific
     tricks with anomalies thanks to it. See rather [noncritical] below. *)
 
-exception UserError of string * std_ppcmds
+exception UserError of string option * std_ppcmds
+(** Main error signaling exception. It carries a header plus a pretty printing
+    doc *)
+
+val user_err : ?loc:Loc.t -> ?hdr:string -> std_ppcmds -> 'a
+(** Main error raising primitive. [user_err ?loc ?hdr pp] signals an
+    error [pp] with optional header and location [hdr] [loc] *)
+
 val error : string -> 'a
-val errorlabstrm : string -> std_ppcmds -> 'a
-val user_err_loc : Loc.t * string * std_ppcmds -> 'a
+(** [error s] just calls [user_error "_" (str s)] *)
 
 exception AlreadyDeclared of std_ppcmds
 val alreadydeclared : std_ppcmds -> 'a
 
-val invalid_arg_loc : Loc.t * string -> 'a
+val invalid_arg : ?loc:Loc.t -> string -> 'a
 
 (** [todo] is for running of an incomplete code its implementation is
    "do nothing" (or print a message), but this function should not be
diff --git a/lib/cList.ml b/lib/cList.ml
index ba592d13f..c8283e3c7 100644
--- a/lib/cList.ml
+++ b/lib/cList.ml
@@ -47,6 +47,8 @@ sig
     ('a -> 'b -> 'c -> 'd -> 'e) -> 'a list -> 'b list -> 'c list -> 'd list -> 'e list
   val filteri :
     (int -> 'a -> bool) -> 'a list -> 'a list
+  val partitioni :
+    (int -> 'a -> bool) -> 'a list -> 'a list * 'a list
   val smartfilter : ('a -> bool) -> 'a list -> 'a list
   val extend : bool list -> 'a -> 'a list -> 'a list
   val count : ('a -> bool) -> 'a list -> int
@@ -63,6 +65,7 @@ sig
   val except : 'a eq -> 'a -> 'a list -> 'a list
   val remove : 'a eq -> 'a -> 'a list -> 'a list
   val remove_first : ('a -> bool) -> 'a list -> 'a list
+  val extract_first : ('a -> bool) -> 'a list -> 'a list * 'a
   val insert : ('a -> 'a -> bool) -> 'a -> 'a list -> 'a list
   val for_all2eq : ('a -> 'b -> bool) -> 'a list -> 'b list -> bool
   val sep_last : 'a list -> 'a * 'a list
@@ -459,6 +462,14 @@ let rec remove_first p = function
   | b::l -> b::remove_first p l
   | [] -> raise Not_found
 
+let extract_first p li =
+  let rec loop rev_left = function
+    | [] -> raise Not_found
+    | x::right ->
+       if p x then List.rev_append rev_left right, x
+       else loop (x :: rev_left) right
+  in loop [] li
+
 let insert p v l =
   let rec insrec = function
     | [] -> [v]
@@ -486,6 +497,15 @@ let filteri p =
   in
   filter_i_rec 0
 
+let partitioni p =
+  let rec aux i = function
+    | [] -> [], []
+    | x :: l ->
+        let (l1, l2) = aux (succ i) l in
+        if p i x then (x :: l1, l2)
+        else (l1, x :: l2)
+  in aux 0
+
 let rec sep_last = function
   | [] -> failwith "sep_last"
   | hd::[] -> (hd,[])
@@ -581,19 +601,35 @@ let filter2 f l1 l2 =
   filter2_loop f c1 c2 l1 l2;
   (c1.tail, c2.tail)
 
-let rec map_filter f = function
-  | [] -> []
-  | x::l ->
-      let l' = map_filter f l in
-      match f x with None -> l' | Some y -> y::l'
+let rec map_filter_loop f p = function
+  | [] -> ()
+  | x :: l ->
+    match f x with
+    | None -> map_filter_loop f p l
+    | Some y ->
+      let c = { head = y; tail = [] } in
+      p.tail <- cast c;
+      map_filter_loop f c l
+
+let map_filter f l =
+  let c = { head = Obj.magic 0; tail = [] } in
+  map_filter_loop f c l;
+  c.tail
 
-let map_filter_i f =
-  let rec aux i = function
-    | [] -> []
-    | x::l ->
-      let l' = aux (succ i) l in
-        match f i x with None -> l' | Some y -> y::l'
-  in aux 0
+let rec map_filter_i_loop f i p = function
+  | [] -> ()
+  | x :: l ->
+    match f i x with
+    | None -> map_filter_i_loop f (succ i) p l
+    | Some y ->
+      let c = { head = y; tail = [] } in
+      p.tail <- cast c;
+      map_filter_i_loop f (succ i) c l
+
+let map_filter_i f l =
+  let c = { head = Obj.magic 0; tail = [] } in
+  map_filter_i_loop f 0 c l;
+  c.tail
 
 let rec filter_with filter l = match filter, l with
 | [], [] -> []
diff --git a/lib/cList.mli b/lib/cList.mli
index 9c7b815c1..bc8749b4f 100644
--- a/lib/cList.mli
+++ b/lib/cList.mli
@@ -89,6 +89,7 @@ sig
   val map4 : ('a -> 'b -> 'c -> 'd -> 'e) -> 'a list -> 'b list -> 'c list ->
     'd list -> 'e list
   val filteri : (int -> 'a -> bool) -> 'a list -> 'a list
+  val partitioni : (int -> 'a -> bool) -> 'a list -> 'a list * 'a list
 
   val smartfilter : ('a -> bool) -> 'a list -> 'a list
   (** [smartfilter f [a1...an] = List.filter f [a1...an]] but if for all i
@@ -124,6 +125,10 @@ sig
   val remove_first : ('a -> bool) -> 'a list -> 'a list
   (** Remove the first element satisfying a predicate, or raise [Not_found] *)
 
+  val extract_first : ('a -> bool) -> 'a list -> 'a list * 'a
+  (** Remove and return the first element satisfying a predicate,
+      or raise [Not_found] *)
+
   val insert : ('a -> 'a -> bool) -> 'a -> 'a list -> 'a list
   (** Insert at the (first) position so that if the list is ordered wrt to the
       total order given as argument, the order is preserved *)
diff --git a/lib/cMap.ml b/lib/cMap.ml
index 4b058380c..ba0873ffa 100644
--- a/lib/cMap.ml
+++ b/lib/cMap.ml
@@ -34,6 +34,7 @@ sig
   val fold_right : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b
   val smartmap : ('a -> 'a) -> 'a t -> 'a t
   val smartmapi : (key -> 'a -> 'a) -> 'a t -> 'a t
+  val height : 'a t -> int
   module Unsafe :
   sig
     val map : (key -> 'a -> key * 'b) -> 'a t -> 'b t
@@ -57,6 +58,7 @@ sig
   val fold_right : (M.t -> 'a -> 'b -> 'b) -> 'a map -> 'b -> 'b
   val smartmap : ('a -> 'a) -> 'a map -> 'a map
   val smartmapi : (M.t -> 'a -> 'a) -> 'a map -> 'a map
+  val height : 'a map -> int
   module Unsafe :
   sig
     val map : (M.t -> 'a -> M.t * 'b) -> 'a map -> 'b map
@@ -168,6 +170,10 @@ struct
     if l == l' && r == r' && v == v' then s
     else map_inj (MNode (l', k, v', r', h))
 
+  let height s = match map_prj s with
+  | MEmpty -> 0
+  | MNode (_, _, _, _, h) -> h
+
   module Unsafe =
   struct
 
diff --git a/lib/cMap.mli b/lib/cMap.mli
index 3ef7fa2c8..2838b374e 100644
--- a/lib/cMap.mli
+++ b/lib/cMap.mli
@@ -61,6 +61,9 @@ sig
   val smartmapi : (key -> 'a -> 'a) -> 'a t -> 'a t
   (** As [mapi] but tries to preserve sharing. *)
 
+  val height : 'a t -> int
+  (** An indication of the logarithmic size of a map *)
+
   module Unsafe :
   sig
     val map : (key -> 'a -> key * 'b) -> 'a t -> 'b t
diff --git a/lib/cString.ml b/lib/cString.ml
index 0c2ed2e7c..61ed03083 100644
--- a/lib/cString.ml
+++ b/lib/cString.ml
@@ -17,7 +17,6 @@ sig
   val explode : string -> string list
   val implode : string list -> string
   val strip : string -> string
-  val map : (char -> char) -> string -> string
   val drop_simple_quotes : string -> string
   val string_index_from : string -> int -> string -> int
   val string_contains : where:string -> what:string -> bool
@@ -78,12 +77,6 @@ let strip s =
   let a = lstrip_rec 0 and b = rstrip_rec (n-1) in
   String.sub s a (b-a+1)
 
-let map f s =
-  let l = String.length s in
-  let r = String.create l in
-  for i = 0 to (l - 1) do r.[i] <- f (s.[i]) done;
-  r
-
 let drop_simple_quotes s =
   let n = String.length s in
   if n > 2 && s.[0] = '\'' && s.[n-1] = '\'' then String.sub s 1 (n-2) else s
diff --git a/lib/cString.mli b/lib/cString.mli
index 5292b34d0..65edfbbe6 100644
--- a/lib/cString.mli
+++ b/lib/cString.mli
@@ -32,9 +32,6 @@ sig
   val strip : string -> string
   (** Remove the surrounding blank characters from a string *)
 
-  val map : (char -> char) -> string -> string
-  (** Apply a function on a string character-wise. *)
-
   val drop_simple_quotes : string -> string
   (** Remove the eventual first surrounding simple quotes of a string. *)
 
diff --git a/lib/cWarnings.ml b/lib/cWarnings.ml
new file mode 100644
index 000000000..2f569d284
--- /dev/null
+++ b/lib/cWarnings.ml
@@ -0,0 +1,188 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+open Pp
+
+type status =
+  Disabled | Enabled | AsError
+
+type t = {
+  default : status;
+  category : string;
+  status : status;
+}
+
+let warnings : (string, t) Hashtbl.t = Hashtbl.create 97
+let categories : (string, string list) Hashtbl.t = Hashtbl.create 97
+
+let current_loc = ref Loc.ghost
+let flags = ref ""
+
+let set_current_loc = (:=) current_loc
+
+let get_flags () = !flags
+
+let add_warning_in_category ~name ~category =
+  let ws =
+    try
+      Hashtbl.find categories category
+    with Not_found -> []
+  in
+  Hashtbl.replace categories category (name::ws)
+
+let refine_loc = function
+  | None when not (Loc.is_ghost !current_loc) -> Some !current_loc
+  | loc -> loc
+
+let create ~name ~category ?(default=Enabled) pp =
+  Hashtbl.add warnings name { default; category; status = default };
+  add_warning_in_category ~name ~category;
+  if default <> Disabled then
+    add_warning_in_category ~name ~category:"default";
+  fun ?loc x -> let w = Hashtbl.find warnings name in
+           match w.status with
+           | Disabled -> ()
+           | AsError ->
+              begin match refine_loc loc with
+              | Some loc -> CErrors.user_err ~loc (pp x)
+              | None -> CErrors.user_err (pp x)
+              end
+           | Enabled ->
+              let msg =
+                pp x ++ spc () ++ str "[" ++ str name ++ str "," ++
+                  str category ++ str "]"
+              in
+              let loc = refine_loc loc in
+              Feedback.msg_warning ?loc msg
+
+let warn_unknown_warning =
+  create ~name:"unknown-warning" ~category:"toplevel"
+         (fun name -> strbrk "Unknown warning name: " ++ str name)
+
+let set_warning_status ~name status =
+  try
+    let w = Hashtbl.find warnings name in 
+    Hashtbl.replace warnings name { w with status = status }
+  with Not_found -> ()
+
+let reset_default_warnings () =
+  Hashtbl.iter (fun name w ->
+                Hashtbl.replace warnings name { w with status = w.default })
+    warnings
+
+let set_all_warnings_status status =
+  Hashtbl.iter (fun name w ->
+                Hashtbl.replace warnings name { w with status })
+    warnings
+
+let set_category_status ~name status =
+  let names = Hashtbl.find categories name in
+  List.iter (fun name -> set_warning_status name status) names
+
+let is_all_keyword name = CString.equal name "all"
+let is_none_keyword s = CString.equal s "none"
+
+let parse_flag s =
+  if String.length s > 1 then
+    match String.get s 0 with
+    | '+' -> (AsError, String.sub s 1 (String.length s - 1))
+    | '-' -> (Disabled, String.sub s 1 (String.length s - 1))
+    | _ -> (Enabled, s)
+  else CErrors.error "Invalid warnings flag"
+
+let string_of_flag (status,name) =
+  match status with
+  | AsError -> "+" ^ name
+  | Disabled -> "-" ^ name
+  | Enabled -> name
+
+let string_of_flags flags =
+  String.concat "," (List.map string_of_flag flags)
+
+let set_status ~name status =
+  if is_all_keyword name then
+    set_all_warnings_status status
+  else
+    try
+      set_category_status ~name status
+    with Not_found ->
+         try
+           set_warning_status ~name status
+         with Not_found -> ()
+
+let split_flags s =
+  let reg = Str.regexp "[ ,]+" in Str.split reg s
+
+let check_warning ~silent (_status,name) =
+  is_all_keyword name ||
+  Hashtbl.mem categories name ||
+  Hashtbl.mem warnings name ||
+  (if not silent then warn_unknown_warning name; false)
+
+(** [cut_before_all_rev] removes all flags subsumed by a later occurrence of the
+    "all" flag, and reverses the list. *)
+let rec cut_before_all_rev acc = function
+  | [] -> acc
+  | (_status,name as w) :: warnings ->
+     cut_before_all_rev (w :: if is_all_keyword name then [] else acc) warnings
+
+let cut_before_all_rev warnings = cut_before_all_rev [] warnings
+
+(** [uniquize_flags_rev] removes flags that are subsumed by later occurrences of
+    themselves or their categories, and reverses the list. *)
+let uniquize_flags_rev flags =
+  let rec aux acc visited = function
+    | (_,name as flag)::flags ->
+       if CString.Set.mem name visited then aux acc visited flags else
+         let visited =
+           try
+             let warnings = Hashtbl.find categories name in
+             List.fold_left (fun v w -> CString.Set.add w v) visited warnings
+           with Not_found ->
+             visited
+         in
+         aux (flag::acc) (CString.Set.add name visited) flags
+    | [] -> acc
+  in aux [] CString.Set.empty flags
+
+(** [normalize_flags] removes unknown or redundant warnings. If [silent] is
+    true, it emits a warning when an unknown warning is met. *)
+let normalize_flags ~silent warnings =
+  let warnings = List.filter (check_warning ~silent) warnings in
+  let warnings = cut_before_all_rev warnings in
+  uniquize_flags_rev warnings
+
+let flags_of_string s = List.map parse_flag (split_flags s)
+
+let normalize_flags_string s =
+  if is_none_keyword s then s
+  else
+    let flags = flags_of_string s in
+    let flags = normalize_flags ~silent:false flags in
+    string_of_flags flags
+
+let rec parse_warnings items =
+  CList.iter (fun (status, name) -> set_status ~name status) items
+
+(* For compatibility, we accept "none" *)
+let parse_flags s =
+  if is_none_keyword s then begin
+      Flags.make_warn false;
+      set_all_warnings_status Disabled;
+      "none"
+    end
+  else begin
+      Flags.make_warn true;
+      let flags = flags_of_string s in
+      let flags = normalize_flags ~silent:true flags in
+      parse_warnings flags;
+      string_of_flags flags
+    end
+
+let set_flags s =
+  reset_default_warnings (); let s = parse_flags s in flags := s
diff --git a/kernel/fast_typeops.mli b/lib/cWarnings.mli
index 05d52b2d3..3f6cee31b 100644
--- a/kernel/fast_typeops.mli
+++ b/lib/cWarnings.mli
@@ -6,18 +6,16 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-open Term
-open Environ
+type status = Disabled | Enabled | AsError
 
-(** {6 Typing functions (not yet tagged as safe) }
-    
-    They return unsafe judgments that are "in context" of a set of 
-    (local) universe variables (the ones that appear in the term)
-    and associated constraints. In case of polymorphic definitions,
-    these variables and constraints will be generalized.
- *)
+val set_current_loc : Loc.t -> unit
 
+val create : name:string -> category:string -> ?default:status ->
+             ('a -> Pp.std_ppcmds) -> ?loc:Loc.t -> 'a -> unit
 
-val infer      : env -> constr       -> unsafe_judgment
-val infer_v    : env -> constr array -> unsafe_judgment array
-val infer_type : env -> types        -> unsafe_type_judgment
+val get_flags : unit -> string
+val set_flags : string -> unit
+
+(** Cleans up a user provided warnings status string, e.g. removing unknown
+    warnings (in which case a warning is emitted) or subsumed warnings . *)
+val normalize_flags_string : string -> string
diff --git a/lib/clib.mllib b/lib/clib.mllib
index c3ec4a696..1e33173ee 100644
--- a/lib/clib.mllib
+++ b/lib/clib.mllib
@@ -21,7 +21,6 @@ Control
 Loc
 CList
 CString
-Serialize
 Deque
 CObj
 CArray
@@ -30,12 +29,8 @@ Util
 Stateid
 Pp
 Ppstyle
-Xml_datatype
 Richpp
 Feedback
-Xml_lexer
-Xml_parser
-Xml_printer
 CUnix
 Envars
 Aux_file
diff --git a/lib/feedback.ml b/lib/feedback.ml
index dce4372ec..57c6f30a4 100644
--- a/lib/feedback.ml
+++ b/lib/feedback.ml
@@ -7,51 +7,14 @@
 (************************************************************************)
 
 open Xml_datatype
-open Serialize
 
 type level =
-  | Debug of string
+  | Debug
   | Info
   | Notice
   | Warning
   | Error
 
-type message = {
-  message_level : level;
-  message_content : xml;
-}
-
-let of_message_level = function
-  | Debug s ->
-      Serialize.constructor "message_level" "debug" [Xml_datatype.PCData s]
-  | Info -> Serialize.constructor "message_level" "info" []
-  | Notice -> Serialize.constructor "message_level" "notice" []
-  | Warning -> Serialize.constructor "message_level" "warning" []
-  | Error -> Serialize.constructor "message_level" "error" []
-let to_message_level =
-  Serialize.do_match "message_level" (fun s args -> match s with
-  | "debug" -> Debug (Serialize.raw_string args)
-  | "info" -> Info
-  | "notice" -> Notice
-  | "warning" -> Warning
-  | "error" -> Error
-  | _ -> raise Serialize.Marshal_error)
-
-let of_message msg =
-  let lvl = of_message_level msg.message_level in
-  let content = Serialize.of_xml msg.message_content in
-  Xml_datatype.Element ("message", [], [lvl; content])
-let to_message xml = match xml with
-  | Xml_datatype.Element ("message", [], [lvl; content]) -> {
-      message_level = to_message_level lvl;
-      message_content = Serialize.to_xml content }
-  | _ -> raise Serialize.Marshal_error
-
-let is_message = function
-  | Xml_datatype.Element ("message", _, _) -> true
-  | _ -> false
-
-
 type edit_id = int
 type state_id = Stateid.t
 type edit_or_state_id = Edit of edit_id | State of state_id
@@ -61,18 +24,18 @@ type feedback_content =
   | Processed
   | Incomplete
   | Complete
-  | ErrorMsg of Loc.t * string
   | ProcessingIn of string
   | InProgress of int
   | WorkerStatus of string * string
-  | Goals of Loc.t * string
   | AddedAxiom
   | GlobRef of Loc.t * string * string * string * string
   | GlobDef of Loc.t * string * string * string
   | FileDependency of string option * string
   | FileLoaded of string * string
+  (* Extra metadata *)
   | Custom of Loc.t * string * xml
-  | Message of message
+  (* Generic messages *)
+  | Message of level * Loc.t option * Richpp.richpp
 
 type feedback = {
   id : edit_or_state_id;
@@ -80,104 +43,15 @@ type feedback = {
   route : route_id;
 }
 
-let to_feedback_content = do_match "feedback_content" (fun s a -> match s,a with
-  | "addedaxiom", _ -> AddedAxiom
-  | "processed", _ -> Processed
-  | "processingin", [where] -> ProcessingIn (to_string where)
-  | "incomplete", _ -> Incomplete
-  | "complete", _ -> Complete
-  | "globref", [loc; filepath; modpath; ident; ty] ->
-       GlobRef(to_loc loc, to_string filepath,
-         to_string modpath, to_string ident, to_string ty)
-  | "globdef", [loc; ident; secpath; ty] ->
-       GlobDef(to_loc loc, to_string ident, to_string secpath, to_string ty)
-  | "errormsg", [loc;  s] -> ErrorMsg (to_loc loc, to_string s)
-  | "inprogress", [n] -> InProgress (to_int n)
-  | "workerstatus", [ns] ->
-       let n, s = to_pair to_string to_string ns in
-       WorkerStatus(n,s)
-  | "goals", [loc;s] -> Goals (to_loc loc, to_string s)
-  | "custom", [loc;name;x]-> Custom (to_loc loc, to_string name, x)
-  | "filedependency", [from; dep] ->
-      FileDependency (to_option to_string from, to_string dep)
-  | "fileloaded", [dirpath; filename] ->
-      FileLoaded (to_string dirpath, to_string filename)
-  | "message", [m] -> Message (to_message m)
-  | _ -> raise Marshal_error)
-let of_feedback_content = function
-  | AddedAxiom -> constructor "feedback_content" "addedaxiom" []
-  | Processed -> constructor "feedback_content" "processed" []
-  | ProcessingIn where ->
-      constructor "feedback_content" "processingin" [of_string where]
-  | Incomplete -> constructor "feedback_content" "incomplete" []
-  | Complete -> constructor "feedback_content" "complete" []
-  | GlobRef(loc, filepath, modpath, ident, ty) ->
-      constructor "feedback_content" "globref" [
-        of_loc loc;
-        of_string filepath;
-        of_string modpath;
-        of_string ident;
-        of_string ty ]
-  | GlobDef(loc, ident, secpath, ty) ->
-      constructor "feedback_content" "globdef" [
-        of_loc loc;
-        of_string ident;
-        of_string secpath;
-        of_string ty ]
-  | ErrorMsg(loc, s) ->
-      constructor "feedback_content" "errormsg" [of_loc loc; of_string s]
-  | InProgress n -> constructor "feedback_content" "inprogress" [of_int n]
-  | WorkerStatus(n,s) ->
-      constructor "feedback_content" "workerstatus"
-        [of_pair of_string of_string (n,s)]
-  | Goals (loc,s) ->
-      constructor "feedback_content" "goals" [of_loc loc;of_string s]
-  | Custom (loc, name, x) ->
-      constructor "feedback_content" "custom" [of_loc loc; of_string name; x]
-  | FileDependency (from, depends_on) ->
-      constructor "feedback_content" "filedependency" [
-        of_option of_string from;
-        of_string depends_on]
-  | FileLoaded (dirpath, filename) ->
-      constructor "feedback_content" "fileloaded" [
-        of_string dirpath;
-        of_string filename ]
-  | Message m -> constructor "feedback_content" "message" [ of_message m ]
-
-let of_edit_or_state_id = function
-  | Edit id -> ["object","edit"], of_edit_id id
-  | State id -> ["object","state"], Stateid.to_xml id
-
-let of_feedback msg =
-  let content = of_feedback_content msg.contents in
-  let obj, id = of_edit_or_state_id msg.id in
-  let route = string_of_int msg.route in
-  Element ("feedback", obj @ ["route",route], [id;content])
-let to_feedback xml = match xml with
-  | Element ("feedback", ["object","edit";"route",route], [id;content]) -> {
-      id = Edit(to_edit_id id);
-      route = int_of_string route;
-      contents = to_feedback_content content }
-  | Element ("feedback", ["object","state";"route",route], [id;content]) -> { 
-      id = State(Stateid.of_xml id);
-      route = int_of_string route;
-      contents = to_feedback_content content }
-  | _ -> raise Marshal_error
-
-let is_feedback = function
-  | Element ("feedback", _, _) -> true
-  | _ -> false
-
 let default_route = 0
 
 (** Feedback and logging *)
 open Pp
 open Pp_control
 
-type logger = level -> std_ppcmds -> unit
+type logger = ?loc:Loc.t -> level -> std_ppcmds -> unit
 
-let msgnl_with fmt strm = msg_with fmt (strm ++ fnl ())
-let msgnl          strm = msgnl_with !std_ft strm
+let msgnl_with ?pp_tag fmt strm = msg_with ?pp_tag fmt (strm ++ fnl ())
 
 (* XXX: This is really painful! *)
 module Emacs = struct
@@ -199,56 +73,118 @@ end
 
 open Emacs
 
-let  dbg_str = str "Debug:"   ++ spc ()
+let  dbg_str = tag Ppstyle.(Tag.inj debug_tag   tag) (str "Debug:")   ++ spc ()
 let info_str = mt ()
-let warn_str = str "Warning:" ++ spc ()
-let  err_str = str "Error:"   ++ spc ()
+let warn_str = tag Ppstyle.(Tag.inj warning_tag tag) (str "Warning:") ++ spc ()
+let  err_str = tag Ppstyle.(Tag.inj error_tag   tag) (str "Error:"  ) ++ spc ()
 
-let make_body quoter info s = quoter (hov 0 (info ++ s))
+let make_body quoter info ?loc s =
+  let loc = Option.cata Pp.pr_loc (Pp.mt ()) loc in
+  quoter (hov 0 (loc ++ info ++ s))
 
 (* Generic logger *)
-let gen_logger dbg err level msg = match level with
-  | Debug _ -> msgnl (make_body dbg  dbg_str msg)
-  | Info    -> msgnl (make_body dbg info_str msg)
-  | Notice  -> msgnl msg
+let gen_logger dbg err ?pp_tag ?loc level msg = match level with
+  | Debug   -> msgnl_with ?pp_tag !std_ft (make_body dbg  dbg_str ?loc msg)
+  | Info    -> msgnl_with ?pp_tag !std_ft (make_body dbg info_str ?loc msg)
+  | Notice  -> msgnl_with ?pp_tag !std_ft msg
   | Warning -> Flags.if_warn (fun () ->
-               msgnl_with !err_ft (make_body err warn_str msg)) ()
-  | Error   -> msgnl_with !err_ft (make_body err  err_str msg)
+               msgnl_with ?pp_tag !err_ft (make_body err warn_str ?loc msg)) ()
+  | Error   -> msgnl_with ?pp_tag !err_ft (make_body err  err_str ?loc msg)
 
-(** Standard loggers *)
-let std_logger   = gen_logger (fun x -> x) (fun x -> x)
+(* We provide a generic clear_log_backend callback for backends
+   wanting to do clenaup after the print.
+*)
+let std_logger_tag     = ref None
+let std_logger_cleanup = ref (fun () -> ())
 
-(* Color logger *)
-let color_terminal_logger level strm =
-  let msg = Ppstyle.color_msg in
-  match level with
-  | Debug _ -> msg ~header:("Debug", Ppstyle.debug_tag) !std_ft strm
-  | Info    -> msg !std_ft strm
-  | Notice  -> msg !std_ft strm
-  | Warning ->
-    let header = ("Warning", Ppstyle.warning_tag) in
-    Flags.if_warn (fun () -> msg ~header !err_ft strm) ()
-  | Error -> msg ~header:("Error", Ppstyle.error_tag) !err_ft strm
+let std_logger ?loc level msg =
+  gen_logger (fun x -> x) (fun x -> x) ?pp_tag:!std_logger_tag ?loc level msg;
+  !std_logger_cleanup ()
 
 (* Rules for emacs:
    - Debug/info: emacs_quote_info
    - Warning/Error: emacs_quote_err
    - Notice: unquoted
+
+  Note the inconsistency.
  *)
-let emacs_logger = gen_logger emacs_quote_info emacs_quote_err
+let emacs_logger = gen_logger emacs_quote_info emacs_quote_err ?pp_tag:None
+
+(** Color logging. Moved from pp_style, it may need some more refactoring  *)
+
+(** Not thread-safe. We should put a lock somewhere if we print from
+    different threads. Do we? *)
+let make_style_stack () =
+  (** Default tag is to reset everything *)
+  let empty = Terminal.make () in
+  let default_tag = Terminal.({
+      fg_color = Some `DEFAULT;
+      bg_color = Some `DEFAULT;
+      bold = Some false;
+      italic = Some false;
+      underline = Some false;
+      negative = Some false;
+    })
+  in
+  let style_stack = ref [] in
+  let peek () = match !style_stack with
+  | []      -> default_tag  (** Anomalous case, but for robustness *)
+  | st :: _ -> st
+  in
+  let push tag =
+    let style = match Ppstyle.get_style tag with
+      | None    -> empty
+      | Some st -> st
+    in
+    (** Use the merging of the latest tag and the one being currently pushed.
+    This may be useful if for instance the latest tag changes the background and
+    the current one the foreground, so that the two effects are additioned. *)
+    let style = Terminal.merge (peek ()) style in
+    style_stack := style :: !style_stack;
+    Terminal.eval style
+  in
+  let pop _ = match !style_stack with
+  | []       -> (** Something went wrong, we fallback *)
+                Terminal.eval default_tag
+  | _ :: rem -> style_stack := rem;
+                Terminal.eval (peek ())
+  in
+  let clear () = style_stack := [] in
+  push, pop, clear
+
+let init_color_output () =
+  let open Pp_control in
+  let push_tag, pop_tag, clear_tag = make_style_stack () in
+  std_logger_cleanup := clear_tag;
+  std_logger_tag     := Some Ppstyle.pp_tag;
+  let tag_handler = {
+    Format.mark_open_tag   = push_tag;
+    Format.mark_close_tag  = pop_tag;
+    Format.print_open_tag  = ignore;
+    Format.print_close_tag = ignore;
+  } in
+  Format.pp_set_mark_tags !std_ft true;
+  Format.pp_set_mark_tags !err_ft true;
+  Format.pp_set_formatter_tag_functions !std_ft tag_handler;
+  Format.pp_set_formatter_tag_functions !err_ft tag_handler
 
 let logger       = ref std_logger
 let set_logger l = logger := l
 
-let msg_info    x = !logger Info x
-let msg_notice  x = !logger Notice x
-let msg_warning x = !logger Warning x
-let msg_error   x = !logger Error x
-let msg_debug   x = !logger (Debug "_") x
+let msg_info    ?loc x = !logger ?loc Info x
+let msg_notice  ?loc x = !logger ?loc Notice x
+let msg_warning ?loc x = !logger ?loc Warning x
+let msg_error   ?loc x = !logger ?loc Error x
+let msg_debug   ?loc x = !logger ?loc Debug x
 
 (** Feeders *)
-let feeder = ref ignore
-let set_feeder f = feeder := f
+let feeders = ref []
+let add_feeder f = feeders := f :: !feeders
+
+let debug_feeder = function
+  | { contents = Message (Debug, loc, pp) } ->
+       msg_debug ?loc (Pp.str (Richpp.raw_print pp))
+  | _ -> ()
 
 let feedback_id    = ref (Edit 0)
 let feedback_route = ref default_route
@@ -257,28 +193,26 @@ let set_id_for_feedback ?(route=default_route) i =
   feedback_id := i; feedback_route := route
 
 let feedback ?id ?route what =
-  !feeder {
+  let m = {
      contents = what;
      route = Option.default !feedback_route route;
      id    = Option.default !feedback_id id;
-  }
+  } in
+  List.iter (fun f -> f m) !feeders
 
-let feedback_logger lvl msg =
-  feedback ~route:!feedback_route ~id:!feedback_id (
-    Message {
-      message_level   = lvl;
-      message_content = Richpp.of_richpp (Richpp.richpp_of_pp msg);
-    })
+let feedback_logger ?loc lvl msg =
+  feedback ~route:!feedback_route ~id:!feedback_id
+    (Message (lvl, loc, Richpp.richpp_of_pp msg))
 
 (* Output to file *)
-let ft_logger old_logger ft level mesg =
+let ft_logger old_logger ft ?loc level mesg =
   let id x = x in
   match level with
-  | Debug _ -> msgnl_with ft (make_body id  dbg_str mesg)
+  | Debug   -> msgnl_with ft (make_body id  dbg_str mesg)
   | Info    -> msgnl_with ft (make_body id info_str mesg)
   | Notice  -> msgnl_with ft mesg
-  | Warning -> old_logger level mesg
-  | Error   -> old_logger level mesg
+  | Warning -> old_logger ?loc level mesg
+  | Error   -> old_logger ?loc level mesg
 
 let with_output_to_file fname func input =
   let old_logger = !logger in
diff --git a/lib/feedback.mli b/lib/feedback.mli
index 1e96f9a49..b4bed8793 100644
--- a/lib/feedback.mli
+++ b/lib/feedback.mli
@@ -10,26 +10,18 @@ open Xml_datatype
 
 (* Old plain messages (used to be in Pp) *)
 type level =
-  | Debug of string
+  | Debug
   | Info
   | Notice
   | Warning
   | Error
 
-type message = {
-  message_level : level;
-  message_content : xml;
-}
-
-val of_message : message -> xml
-val to_message : xml -> message
-val is_message : xml -> bool
-
 
 (** Coq "semantic" infos obtained during parsing/execution *)
 type edit_id = int
 type state_id = Stateid.t
 type edit_or_state_id = Edit of edit_id | State of state_id
+
 type route_id = int
 
 val default_route : route_id
@@ -39,13 +31,11 @@ type feedback_content =
   | Processed
   | Incomplete
   | Complete
-  | ErrorMsg of Loc.t * string
   (* STM optional data *)
   | ProcessingIn of string
   | InProgress of int
   | WorkerStatus of string * string
   (* Generally useful metadata *)
-  | Goals of Loc.t * string
   | AddedAxiom
   | GlobRef of Loc.t * string * string * string * string
   | GlobDef of Loc.t * string * string * string
@@ -53,19 +43,15 @@ type feedback_content =
   | FileLoaded of string * string
   (* Extra metadata *)
   | Custom of Loc.t * string * xml
-  (* Old generic messages *)
-  | Message of message
+  (* Generic messages *)
+  | Message of level * Loc.t option * Richpp.richpp
 
 type feedback = {
-  id : edit_or_state_id;       (* The document part concerned *)
+  id       : edit_or_state_id;  (* The document part concerned *)
   contents : feedback_content;  (* The payload *)
-  route : route_id;            (* Extra routing info *)
+  route    : route_id;          (* Extra routing info *)
 }
 
-val of_feedback : feedback -> xml
-val to_feedback : xml -> feedback
-val is_feedback : xml -> bool
-
 (** {6 Feedback sent, even asynchronously, to the user interface} *)
 
 (** Moved here from pp.ml *)
@@ -77,7 +63,7 @@ val is_feedback : xml -> bool
  * Only one among state_id and edit_id can be provided. *)
 
 (** A [logger] takes a level plus a pretty printing doc and logs it *)
-type logger = level -> Pp.std_ppcmds -> unit
+type logger = ?loc:Loc.t -> level -> Pp.std_ppcmds -> unit
 
 (** [set_logger l] makes the [msg_*] to use [l] for logging *)
 val set_logger : logger -> unit
@@ -85,19 +71,19 @@ val set_logger : logger -> unit
 (** [std_logger] standard logger to [stdout/stderr]  *)
 val std_logger : logger
 
-val color_terminal_logger : logger
-(* This logger will apply the proper {!Pp_style} tags, and in
-   particular use the formatters {!Pp_control.std_ft} and
-   {!Pp_control.err_ft} to display those messages. Be careful this is
-   not compatible with the Emacs mode!  *)
+(** [init_color_output ()] Enable color in the std_logger *)
+val init_color_output : unit -> unit
 
 (** [feedback_logger] will produce feedback messages instead IO events *)
 val feedback_logger : logger
 val emacs_logger    : logger
 
 
-(** [set_feeder] A feeder processes the feedback, [ignore] by default *)
-val set_feeder : (feedback -> unit) -> unit
+(** [add_feeder] feeders observe the feedback *)
+val add_feeder : (feedback -> unit) -> unit
+
+(** Prints feedback messages of kind Message(Debug,_) using msg_debug *)
+val debug_feeder : feedback -> unit
 
 (** [feedback ?id ?route fb] produces feedback fb, with [route] and
     [id] set appropiatedly, if absent, it will use the defaults set by
@@ -122,22 +108,22 @@ relaxed. *)
 (* Should we advertise these functions more? Should they be the ONLY
    allowed way to output something? *)
 
-val msg_info : Pp.std_ppcmds -> unit
+val msg_info : ?loc:Loc.t -> Pp.std_ppcmds -> unit
 (** Message that displays information, usually in verbose mode, such as [Foobar
     is defined] *)
 
-val msg_notice : Pp.std_ppcmds -> unit
+val msg_notice : ?loc:Loc.t -> Pp.std_ppcmds -> unit
 (** Message that should be displayed, such as [Print Foo] or [Show Bar]. *)
 
-val msg_warning : Pp.std_ppcmds -> unit
+val msg_warning : ?loc:Loc.t -> Pp.std_ppcmds -> unit
 (** Message indicating that something went wrong, but without serious
     consequences. *)
 
-val msg_error : Pp.std_ppcmds -> unit
+val msg_error : ?loc:Loc.t -> Pp.std_ppcmds -> unit
 (** Message indicating that something went really wrong, though still
     recoverable; otherwise an exception would have been raised. *)
 
-val msg_debug : Pp.std_ppcmds -> unit
+val msg_debug : ?loc:Loc.t -> Pp.std_ppcmds -> unit
 (** For debugging purposes *)
 
 
diff --git a/lib/flags.ml b/lib/flags.ml
index c1ec9738c..5b080151c 100644
--- a/lib/flags.ml
+++ b/lib/flags.ml
@@ -47,6 +47,7 @@ let batch_mode = ref false
 
 type compilation_mode = BuildVo | BuildVio | Vio2Vo
 let compilation_mode = ref BuildVo
+let compilation_output_name = ref None
 
 let test_mode = ref false
 
@@ -68,11 +69,15 @@ let priority_of_string = function
   | "low" -> Low
   | "high" -> High
   | _ -> raise (Invalid_argument "priority_of_string")
+type tac_error_filter = [ `None | `Only of string list | `All ]
+let async_proofs_tac_error_resilience = ref (`Only [ "curly" ])
+let async_proofs_cmd_error_resilience = ref true
 
 let async_proofs_is_worker () =
   !async_proofs_worker_id <> "master"
 let async_proofs_is_master () =
   !async_proofs_mode = APon && !async_proofs_worker_id = "master"
+let async_proofs_delegation_threshold = ref 0.03
 
 let debug = ref false
 let in_debugger = ref false
@@ -103,21 +108,29 @@ let we_are_parsing = ref false
 (* Current means no particular compatibility consideration.
    For correct comparisons, this constructor should remain the last one. *)
 
-type compat_version = V8_2 | V8_3 | V8_4 | V8_5 | Current
+type compat_version = V8_2 | V8_3 | V8_4 | V8_5 | V8_6 | Current
 
 let compat_version = ref Current
 
-let version_strictly_greater v = match !compat_version, v with
-| V8_2, (V8_2 | V8_3 | V8_4 | V8_5 | Current) -> false
-| V8_3, (V8_3 | V8_4 | V8_5 | Current) -> false
-| V8_4, (V8_4 | V8_5 | Current) -> false
-| V8_5, (V8_5 | Current) -> false
-| Current, Current -> false
-| V8_3, V8_2 -> true
-| V8_4, (V8_2 | V8_3) -> true
-| V8_5, (V8_2 | V8_3 | V8_4) -> true
-| Current, (V8_2 | V8_3 | V8_4 | V8_5) -> true
-
+let version_compare v1 v2 = match v1, v2 with
+| V8_2, V8_2 -> 0
+| V8_2, (V8_3 | V8_4 | V8_5 | V8_6 | Current) -> -1
+| V8_3, V8_2 -> 1
+| V8_3, V8_3 -> 0
+| V8_3, (V8_4 | V8_5 | V8_6 | Current) -> -1
+| V8_4, (V8_2 | V8_3) -> 1
+| V8_4, V8_4 -> 0
+| V8_4, (V8_5 | V8_6 | Current) -> -1
+| V8_5, (V8_2 | V8_3 | V8_4) -> 1
+| V8_5, V8_5 -> 0
+| V8_5, (V8_6 | Current) -> -1
+| V8_6, (V8_2 | V8_3 | V8_4 | V8_5) -> 1
+| V8_6, V8_6 -> 0
+| V8_6, Current -> -1
+| Current, Current -> 0
+| Current, (V8_2 | V8_3 | V8_4 | V8_5 | V8_6) -> 1
+
+let version_strictly_greater v = version_compare !compat_version v > 0
 let version_less_or_equal v = not (version_strictly_greater v)
 
 let pr_version = function
@@ -125,12 +138,11 @@ let pr_version = function
   | V8_3 -> "8.3"
   | V8_4 -> "8.4"
   | V8_5 -> "8.5"
+  | V8_6 -> "8.6"
   | Current -> "current"
 
 (* Translate *)
 let beautify = ref false
-let make_beautify f = beautify := f
-let do_beautify () = !beautify
 let beautify_file = ref false
 
 (* Silent / Verbose *)
@@ -167,7 +179,7 @@ let make_polymorphic_flag b =
 let program_mode = ref false
 let is_program_mode () = !program_mode
 
-let warn = ref false
+let warn = ref true
 let make_warn flag = warn := flag;  ()
 let if_warn f x = if !warn then f x
 
@@ -220,6 +232,8 @@ let native_compiler = ref false
 let print_mod_uid = ref false
 
 let tactic_context_compat = ref false
+let profile_ltac = ref false
+let profile_ltac_cutoff = ref 2.0
 
 let dump_bytecode = ref false
 let set_dump_bytecode = (:=) dump_bytecode
diff --git a/lib/flags.mli b/lib/flags.mli
index 24780f0dc..bd365e653 100644
--- a/lib/flags.mli
+++ b/lib/flags.mli
@@ -14,6 +14,7 @@ val load_init : bool ref
 val batch_mode : bool ref
 type compilation_mode = BuildVo | BuildVio | Vio2Vo
 val compilation_mode : compilation_mode ref
+val compilation_output_name : string option ref
 
 val test_mode : bool ref
 
@@ -34,6 +35,10 @@ type priority = Low | High
 val async_proofs_worker_priority : priority ref
 val string_of_priority : priority -> string
 val priority_of_string : string -> priority
+type tac_error_filter = [ `None | `Only of string list | `All ]
+val async_proofs_tac_error_resilience : tac_error_filter ref
+val async_proofs_cmd_error_resilience : bool ref
+val async_proofs_delegation_threshold : float ref
 
 val debug : bool ref
 val in_debugger : bool ref
@@ -57,15 +62,14 @@ val raw_print : bool ref
 val record_print : bool ref
 val univ_print : bool ref
 
-type compat_version = V8_2 | V8_3 | V8_4 | V8_5 | Current
+type compat_version = V8_2 | V8_3 | V8_4 | V8_5 | V8_6 | Current
 val compat_version : compat_version ref
+val version_compare : compat_version -> compat_version -> int
 val version_strictly_greater : compat_version -> bool
 val version_less_or_equal : compat_version -> bool
 val pr_version : compat_version -> string
 
 val beautify : bool ref
-val make_beautify : bool -> unit
-val do_beautify : unit -> bool
 val beautify_file : bool ref
 
 val make_silent : bool -> unit
@@ -143,6 +147,9 @@ val tactic_context_compat : bool ref
 (** Set to [true] to trigger the compatibility bugged context matching (old
     context vs. appcontext) is set. *)
 
+val profile_ltac : bool ref
+val profile_ltac_cutoff : float ref
+
 (** Dump the bytecode after compilation (for debugging purposes) *)
 val dump_bytecode : bool ref
 val set_dump_bytecode : bool -> unit
diff --git a/lib/future.ml b/lib/future.ml
index 9cdc1c20e..ea0382a63 100644
--- a/lib/future.ml
+++ b/lib/future.ml
@@ -30,10 +30,10 @@ let customize_not_here_msg f = not_here_msg := f
 
 exception NotReady of string
 exception NotHere of string
-let _ = Errors.register_handler (function
+let _ = CErrors.register_handler (function
   | NotReady name -> !not_ready_msg name
   | NotHere name -> !not_here_msg name
-  | _ -> raise Errors.Unhandled)
+  | _ -> raise CErrors.Unhandled)
 
 type fix_exn = Exninfo.iexn -> Exninfo.iexn
 let id x = prerr_endline "Future: no fix_exn.\nYou have probably created a Future.computation from a value without passing the ~fix_exn argument.  You probably want to chain with an already existing future instead."; x
@@ -136,7 +136,7 @@ let rec compute ~pure ck : 'a value =
         let state = if pure then None else Some (!freeze ()) in
         c := Val (data, state); `Val data
       with e ->
-        let e = Errors.push e in
+        let e = CErrors.push e in
         let e = fix_exn e in
         match e with
         | (NotReady _, _) -> `Exn e
@@ -156,9 +156,9 @@ let chain ~pure ck f =
   | Val (v, Some state) -> Closure (fun () -> !unfreeze state; f v)
   | Val (v, None) ->
       match !ck with
-      | Finished _ -> Errors.anomaly(Pp.str
+      | Finished _ -> CErrors.anomaly(Pp.str
           "Future.chain ~pure:false call on an already joined computation")
-      | Ongoing _ -> Errors.anomaly(Pp.strbrk(
+      | Ongoing _ -> CErrors.anomaly(Pp.strbrk(
           "Future.chain ~pure:false call on a pure computation. "^
           "This can happen if the computation was initial created with "^
           "Future.from_val or if it was Future.chain ~pure:true with a "^
@@ -170,7 +170,7 @@ let replace kx y =
   let _, _, _, x = get kx in
   match !x with
   | Exn _ -> x := Closure (fun () -> force ~pure:false y)
-  | _ -> Errors.anomaly
+  | _ -> CErrors.anomaly
            (Pp.str "A computation can be replaced only if is_exn holds")
 
 let purify f x =
@@ -180,13 +180,13 @@ let purify f x =
     !unfreeze state;
     v
   with e ->
-    let e = Errors.push e in !unfreeze state; Exninfo.iraise e
+    let e = CErrors.push e in !unfreeze state; Exninfo.iraise e
 
 let transactify f x =
   let state = !freeze () in
   try f x
   with e ->
-    let e = Errors.push e in !unfreeze state; Exninfo.iraise e
+    let e = CErrors.push e in !unfreeze state; Exninfo.iraise e
 
 let purify_future f x = if is_over x then f x else purify f x
 let compute x = purify_future (compute ~pure:false) x
@@ -213,7 +213,7 @@ let map2 ?greedy f x l =
     let xi = chain ?greedy ~pure:true x (fun x ->
         try List.nth x i
         with Failure _ | Invalid_argument _ ->
-          Errors.anomaly (Pp.str "Future.map2 length mismatch")) in
+          CErrors.anomaly (Pp.str "Future.map2 length mismatch")) in
     f xi y) 0 l
 
 let print f kx =
diff --git a/lib/future.mli b/lib/future.mli
index 114c59176..c780faf32 100644
--- a/lib/future.mli
+++ b/lib/future.mli
@@ -87,7 +87,7 @@ val from_val : ?fix_exn:fix_exn -> 'a -> 'a computation
    the value is not just the 'a but also the global system state *)
 val from_here : ?fix_exn:fix_exn -> 'a -> 'a computation
 
-(* To get the fix_exn of a computation and build a Tacexpr.declaration_hook.
+(* To get the fix_exn of a computation and build a Lemmas.declaration_hook.
  * When a future enters the environment a corresponding hook is run to perform
  * some work.  If this fails, then its failure has to be annotated with the
  * same state id that corresponds to the future computation end.  I.e. Qed
diff --git a/lib/genarg.ml b/lib/genarg.ml
index 69408fb1a..05c828d5f 100644
--- a/lib/genarg.ml
+++ b/lib/genarg.ml
@@ -159,7 +159,7 @@ let create_arg name =
   match ArgT.name name with
   | None -> ExtraArg (ArgT.create name)
   | Some _ ->
-    Errors.anomaly (str "generic argument already declared: " ++ str name)
+    CErrors.anomaly (str "generic argument already declared: " ++ str name)
 
 let make0 = create_arg
 
@@ -181,7 +181,7 @@ struct
   | ExtraArg s ->
     if GenMap.mem s !arg0_map then
       let msg = str M.name ++ str " function already registered: " ++ str (ArgT.repr s) in
-      Errors.anomaly msg
+      CErrors.anomaly msg
     else
       arg0_map := GenMap.add s (GenMap.Pack f) !arg0_map
   | _ -> assert false
@@ -192,7 +192,7 @@ struct
     with Not_found ->
       match M.default (ExtraArg name) with
       | None ->
-        Errors.anomaly (str M.name ++ str " function not found: " ++ str (ArgT.repr name))
+        CErrors.anomaly (str M.name ++ str " function not found: " ++ str (ArgT.repr name))
       | Some obj -> obj
 
   (** For now, the following function is quite dummy and should only be applied
diff --git a/lib/genarg.mli b/lib/genarg.mli
index b8bb6af04..d7ad9b93b 100644
--- a/lib/genarg.mli
+++ b/lib/genarg.mli
@@ -6,6 +6,8 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
+(** Generic arguments used by the extension mechanisms of several Coq ASTs. *)
+
 (** The route of a generic argument, from parsing to evaluation.
 In the following diagram, "object" can be tactic_expr, constr, tactic_arg, etc.
 
@@ -34,36 +36,10 @@ In the following diagram, "object" can be tactic_expr, constr, tactic_arg, etc.
 effective use
 {% \end{%}verbatim{% }%}
 
-To distinguish between the uninterpreted (raw), globalized and
+To distinguish between the uninterpreted, globalized and
 interpreted worlds, we annotate the type [generic_argument] by a
-phantom argument which is either [constr_expr], [glob_constr] or
-[constr].
+phantom argument.
 
-Transformation for each type :
-{% \begin{%}verbatim{% }%}
-tag                            raw open type            cooked closed type
-
-BoolArgType                    bool                      bool
-IntArgType                     int                       int
-IntOrVarArgType                int or_var                int
-StringArgType                  string (parsed w/ "")     string
-PreIdentArgType                string (parsed w/o "")    (vernac only)
-IdentArgType true              identifier                identifier
-IdentArgType false             identifier (pattern_ident) identifier
-IntroPatternArgType            intro_pattern_expr        intro_pattern_expr
-VarArgType                     identifier located        identifier
-RefArgType                     reference                 global_reference
-QuantHypArgType                quantified_hypothesis     quantified_hypothesis
-ConstrArgType                  constr_expr               constr
-ConstrMayEvalArgType           constr_expr may_eval      constr
-OpenConstrArgType              open_constr_expr          open_constr
-ConstrWithBindingsArgType      constr_expr with_bindings constr with_bindings
-BindingsArgType                constr_expr bindings      constr bindings
-List0ArgType of argument_type
-List1ArgType of argument_type
-OptArgType of argument_type
-ExtraArgType of string         '_a                      '_b
-{% \end{%}verbatim{% }%}
 *)
 
 (** {5 Generic types} *)
@@ -77,14 +53,14 @@ sig
   val name : string -> any option
 end
 
+(** Generic types. The first parameter is the OCaml lowest level, the second one
+    is the globalized level, and third one the internalized level. *)
 type (_, _, _) genarg_type =
 | ExtraArg : ('a, 'b, 'c) ArgT.tag -> ('a, 'b, 'c) genarg_type
 | ListArg : ('a, 'b, 'c) genarg_type -> ('a list, 'b list, 'c list) genarg_type
 | OptArg : ('a, 'b, 'c) genarg_type -> ('a option, 'b option, 'c option) genarg_type
 | PairArg : ('a1, 'b1, 'c1) genarg_type * ('a2, 'b2, 'c2) genarg_type ->
   ('a1 * 'a2, 'b1 * 'b2, 'c1 * 'c2) genarg_type
-(** Generic types. ['raw] is the OCaml lowest level, ['glob] is the globalized
-    one, and ['top] the internalized one. *)
 
 type 'a uniform_genarg_type = ('a, 'a, 'a) genarg_type
 (** Alias for concision when the three types agree. *)
@@ -99,21 +75,18 @@ val create_arg : string -> ('raw, 'glob, 'top) genarg_type
 (** {5 Specialized types} *)
 
 (** All of [rlevel], [glevel] and [tlevel] must be non convertible
-   to ensure the injectivity of the type inference from type
-   ['co generic_argument] to [('a,'co) abstract_argument_type];
-   this guarantees that, for 'co fixed, the type of
-   out_gen is monomorphic over 'a, hence type-safe
-*)
+    to ensure the injectivity of the GADT type inference. *)
 
 type rlevel = [ `rlevel ]
 type glevel = [ `glevel ]
 type tlevel = [ `tlevel ]
 
+(** Generic types at a fixed level. The first parameter embeds the OCaml type
+    and the second one the level. *)
 type (_, _) abstract_argument_type =
 | Rawwit : ('a, 'b, 'c) genarg_type -> ('a, rlevel) abstract_argument_type
 | Glbwit : ('a, 'b, 'c) genarg_type -> ('b, glevel) abstract_argument_type
 | Topwit : ('a, 'b, 'c) genarg_type -> ('c, tlevel) abstract_argument_type
-(** Type at level ['co] represented by an OCaml value of type ['a]. *)
 
 type 'a raw_abstract_argument_type = ('a, rlevel) abstract_argument_type
 (** Specialized type at raw level. *)
@@ -207,9 +180,11 @@ sig
 
 end
 
-(** {5 Basic generic type constructors} *)
+(** {5 Compatibility layer}
+
+The functions below are aliases for generic_type constructors.
 
-(** {6 Parameterized types} *)
+*)
 
 val wit_list : ('a, 'b, 'c) genarg_type -> ('a list, 'b list, 'c list) genarg_type
 val wit_opt : ('a, 'b, 'c) genarg_type -> ('a option, 'b option, 'c option) genarg_type
diff --git a/lib/hMap.ml b/lib/hMap.ml
index 778c366fd..ea76e7427 100644
--- a/lib/hMap.ml
+++ b/lib/hMap.ml
@@ -68,34 +68,91 @@ struct
         Int.Map.update h m s
     with Not_found -> s
 
+  let height s = Int.Map.height s
+
+  let is_smaller s1 s2 = height s1 <= height s2 + 3
+
+  (** Assumes s1 << s2 *)
+  let fast_union s1 s2 =
+    let fold h s accu =
+      try Int.Map.modify h (fun _ s' -> Set.fold Set.add s s') accu
+      with Not_found -> Int.Map.add h s accu
+    in
+    Int.Map.fold fold s1 s2
+
   let union s1 s2 =
-    let fu _ m1 m2 = match m1, m2 with
-    | None, None -> None
-    | (Some _ as m), None | None, (Some _ as m) -> m
-    | Some m1, Some m2 -> Some (Set.union m1 m2)
+    if is_smaller s1 s2 then fast_union s1 s2
+    else if is_smaller s2 s1 then fast_union s2 s1
+    else
+      let fu _ m1 m2 = match m1, m2 with
+      | None, None -> None
+      | (Some _ as m), None | None, (Some _ as m) -> m
+      | Some m1, Some m2 -> Some (Set.union m1 m2)
+      in
+      Int.Map.merge fu s1 s2
+
+  (** Assumes s1 << s2 *)
+  let fast_inter s1 s2 =
+    let fold h s accu =
+      try
+        let s' = Int.Map.find h s2 in
+        let si = Set.filter (fun e -> Set.mem e s') s in
+        if Set.is_empty si then accu
+        else Int.Map.add h si accu
+     with Not_found -> accu
     in
-    Int.Map.merge fu s1 s2
+    Int.Map.fold fold s1 Int.Map.empty
 
   let inter s1 s2 =
-    let fu _ m1 m2 = match m1, m2 with
-    | None, None -> None
-    | Some _, None | None, Some _ -> None
-    | Some m1, Some m2 ->
-      let m = Set.inter m1 m2 in
-      if Set.is_empty m then None else Some m
+    if is_smaller s1 s2 then fast_inter s1 s2
+    else if is_smaller s2 s1 then fast_inter s2 s1
+    else
+      let fu _ m1 m2 = match m1, m2 with
+      | None, None -> None
+      | Some _, None | None, Some _ -> None
+      | Some m1, Some m2 ->
+        let m = Set.inter m1 m2 in
+        if Set.is_empty m then None else Some m
+      in
+      Int.Map.merge fu s1 s2
+
+  (** Assumes s1 << s2 *)
+  let fast_diff_l s1 s2 =
+    let fold h s accu =
+      try
+        let s' = Int.Map.find h s2 in
+        let si = Set.filter (fun e -> not (Set.mem e s')) s in
+        if Set.is_empty si then accu
+        else Int.Map.add h si accu
+     with Not_found -> Int.Map.add h s accu
+    in
+    Int.Map.fold fold s1 Int.Map.empty
+
+  (** Assumes s2 << s1 *)
+  let fast_diff_r s1 s2 =
+    let fold h s accu =
+      try
+        let s' = Int.Map.find h accu in
+        let si = Set.filter (fun e -> not (Set.mem e s)) s' in
+        if Set.is_empty si then Int.Map.remove h accu
+        else Int.Map.update h si accu
+     with Not_found -> accu
     in
-    Int.Map.merge fu s1 s2
+    Int.Map.fold fold s2 s1
 
   let diff s1 s2 =
-    let fu _ m1 m2 = match m1, m2 with
-    | None, None -> None
-    | (Some _ as m), None -> m
-    | None, Some _ -> None
-    | Some m1, Some m2 ->
-      let m = Set.diff m1 m2 in
-      if Set.is_empty m then None else Some m
-    in
-    Int.Map.merge fu s1 s2
+    if is_smaller s1 s2 then fast_diff_l s1 s2
+    else if is_smaller s2 s2 then fast_diff_r s1 s2
+    else
+      let fu _ m1 m2 = match m1, m2 with
+      | None, None -> None
+      | (Some _ as m), None -> m
+      | None, Some _ -> None
+      | Some m1, Some m2 ->
+        let m = Set.diff m1 m2 in
+        if Set.is_empty m then None else Some m
+      in
+      Int.Map.merge fu s1 s2
 
   let compare s1 s2 = Int.Map.compare Set.compare s1 s2
 
@@ -324,6 +381,8 @@ struct
     let fs m = Map.smartmapi f m in
     Int.Map.smartmap fs s
 
+  let height s = Int.Map.height s
+
   module Unsafe =
   struct
     let map f s =
diff --git a/lib/lib.mllib b/lib/lib.mllib
index a6c09058d..8791f0741 100644
--- a/lib/lib.mllib
+++ b/lib/lib.mllib
@@ -1,4 +1,5 @@
-Errors
+CErrors
+CWarnings
 Bigint
 Segmenttree
 Unicodetable
diff --git a/lib/loc.ml b/lib/loc.ml
index afdab928c..e373a760c 100644
--- a/lib/loc.ml
+++ b/lib/loc.ml
@@ -8,7 +8,6 @@
 
 (* Locations management *)
 
-
 type t = {
   fname : string; (** filename *)
   line_nb : int; (** start line number *)
@@ -19,7 +18,7 @@ type t = {
   ep : int; (** end position *)
 }
 
-let create fname line_nb bol_pos (bp, ep) = {
+let create fname line_nb bol_pos bp ep = {
   fname = fname; line_nb = line_nb; bol_pos = bol_pos;
   line_nb_last = line_nb; bol_pos_last = bol_pos; bp = bp; ep = ep; }
 
@@ -54,8 +53,6 @@ let merge loc1 loc2 =
 
 let unloc loc = (loc.bp, loc.ep)
 
-let represent loc = (loc.fname, loc.line_nb, loc.bol_pos, loc.bp, loc.ep)
-
 let dummy_loc = ghost
 let join_loc = merge
 
@@ -74,6 +71,9 @@ let add_loc e loc = Exninfo.add e location loc
 
 let get_loc e = Exninfo.get e location
 
-let raise loc e =
-  let info = Exninfo.add Exninfo.null location loc in
-  Exninfo.iraise (e, info)
+let raise ?loc e =
+  match loc with
+  | None     -> raise e
+  | Some loc ->
+    let info = Exninfo.add Exninfo.null location loc in
+    Exninfo.iraise (e, info)
diff --git a/lib/loc.mli b/lib/loc.mli
index f39cd2670..bb88f8642 100644
--- a/lib/loc.mli
+++ b/lib/loc.mli
@@ -8,7 +8,15 @@
 
 (** {5 Basic types} *)
 
-type t
+type t = {
+  fname : string; (** filename *)
+  line_nb : int; (** start line number *)
+  bol_pos : int; (** position of the beginning of start line *)
+  line_nb_last : int; (** end line number *)
+  bol_pos_last : int; (** position of the beginning of end line *)
+  bp : int; (** start position *)
+  ep : int; (** end position *)
+}
 
 type 'a located = t * 'a
 (** Embed a location in a type *)
@@ -17,9 +25,9 @@ type 'a located = t * 'a
 
 (** This is inherited from CAMPL4/5. *)
 
-val create : string -> int -> int -> (int * int) -> t
+val create : string -> int -> int -> int -> int -> t
 (** Create a location from a filename, a line number, a position of the
-    beginning of the line and a pair of start and end position *)
+    beginning of the line, a start and end position *)
 
 val unloc : t -> int * int
 (** Return the start and end position of a location *)
@@ -35,9 +43,6 @@ val is_ghost : t -> bool
 
 val merge : t -> t -> t
 
-val represent : t -> (string * int * int * int * int)
-(** Return the arguments given in [create] *)
-
 (** {5 Located exceptions} *)
 
 val add_loc : Exninfo.info -> t -> Exninfo.info
@@ -46,7 +51,7 @@ val add_loc : Exninfo.info -> t -> Exninfo.info
 val get_loc : Exninfo.info -> t option
 (** Retrieving the optional location of an exception *)
 
-val raise : t -> exn -> 'a
+val raise : ?loc:t -> exn -> 'a
 (** [raise loc e] is the same as [Pervasives.raise (add_loc e loc)]. *)
 
 (** {5 Location utilities} *)
diff --git a/lib/minisys.ml b/lib/minisys.ml
index 25e4d79c4..f15021c65 100644
--- a/lib/minisys.ml
+++ b/lib/minisys.ml
@@ -46,14 +46,6 @@ let ok_dirname f =
 let exists_dir dir =
   try Sys.is_directory dir with Sys_error _ -> false
 
-let check_unix_dir warn dir =
-  if (Sys.os_type = "Win32" || Sys.os_type = "Cygwin") &&
-    (String.length dir > 2 && dir.[1] = ':' ||
-     String.contains dir '\\' ||
-     String.contains dir ';')
-  then warn ("assuming " ^ dir ^
-             " to be a Unix path even if looking like a Win32 path.")
-
 let apply_subdir f path name =
   (* we avoid all files and subdirs starting by '.' (e.g. .svn) *)
   (* as well as skipped files like CVS, ... *)
diff --git a/lib/monad.ml b/lib/monad.ml
index a1714a41b..2e55e9698 100644
--- a/lib/monad.ml
+++ b/lib/monad.ml
@@ -64,6 +64,9 @@ module type ListS = sig
       its second argument in a tail position. *)
   val iter : ('a -> unit t) -> 'a list -> unit t
 
+  (** Like the regular {!CList.map_filter}. The monadic effects are threaded left*)
+  val map_filter : ('a -> 'b option t) -> 'a list -> 'b list t
+
 
   (** {6 Two-list iterators} *)
 
@@ -138,6 +141,14 @@ module Make (M:Def) : S with type +'a t = 'a M.t = struct
       | a::b::l -> f a >> f b >> iter f l
 
 
+    let rec map_filter f = function
+      | [] -> return []
+      | a::l ->
+        f a >>= function
+        | None -> map_filter f l
+        | Some b ->
+          map_filter f l >>= fun filtered ->
+          return (b::filtered)
 
     let rec fold_left2 r f x l1 l2 =
       match l1,l2 with
diff --git a/lib/monad.mli b/lib/monad.mli
index c8655efa0..7b0a3e600 100644
--- a/lib/monad.mli
+++ b/lib/monad.mli
@@ -66,6 +66,10 @@ module type ListS = sig
       its second argument in a tail position. *)
   val iter : ('a -> unit t) -> 'a list -> unit t
 
+  (** Like the regular {!CList.map_filter}. The monadic effects are
+      threaded left to right. *)
+  val map_filter : ('a -> 'b option t) -> 'a list -> 'b list t
+
 
   (** {6 Two-list iterators} *)
 
diff --git a/lib/pp.ml b/lib/pp.ml
index d8e12ea6e..a51b4458f 100644
--- a/lib/pp.ml
+++ b/lib/pp.ml
@@ -75,17 +75,6 @@ open Pp_control
    \end{description}
  *)
 
-let comments = ref []
-
-let rec split_com comacc acc pos = function
-    [] -> comments := List.rev acc; comacc
-  | ((b,e),c as com)::coms ->
-      (* Take all comments that terminates before pos, or begin exactly
-         at pos (used to print comments attached after an expression) *)
-      if e<=pos || pos=b then split_com (c::comacc) acc pos coms
-      else  split_com comacc (com::acc) pos coms
-
-
 type block_type =
   | Pp_hbox of int
   | Pp_vbox of int
@@ -105,7 +94,7 @@ type 'a ppcmd_token =
   | Ppcmd_print_if_broken
   | Ppcmd_open_box of block_type
   | Ppcmd_close_box
-  | Ppcmd_comment of int
+  | Ppcmd_comment of string list
   | Ppcmd_open_tag of Tag.t
   | Ppcmd_close_tag
 
@@ -169,7 +158,7 @@ let brk (a,b) = Glue.atom(Ppcmd_print_break (a,b))
 let fnl () = Glue.atom(Ppcmd_force_newline)
 let pifb () = Glue.atom(Ppcmd_print_if_broken)
 let ws n = Glue.atom(Ppcmd_white_space n)
-let comment n = Glue.atom(Ppcmd_comment n)
+let comment l = Glue.atom(Ppcmd_comment l)
 
 (* derived commands *)
 let mt () = Glue.empty
@@ -189,6 +178,25 @@ let strbrk s =
     else if p = n then [] else [str (String.sub s p (n-p))]
   in List.fold_left (++) Glue.empty (aux 0 0)
 
+let pr_loc_pos loc =
+  if Loc.is_ghost loc then (str"<unknown>")
+  else
+    let loc = Loc.unloc loc in
+    int (fst loc) ++ str"-" ++ int (snd loc)
+
+let pr_loc loc =
+  if Loc.is_ghost loc then str"<unknown>" ++ fnl ()
+  else
+    let fname = loc.Loc.fname in
+    if CString.equal fname "" then
+      Loc.(str"Toplevel input, characters " ++ int loc.bp ++
+	   str"-" ++ int loc.ep ++ str":" ++ fnl ())
+    else
+      Loc.(str"File " ++ str "\"" ++ str fname ++ str "\"" ++
+	   str", line " ++ int loc.line_nb ++ str", characters " ++
+	   int (loc.bp-loc.bol_pos) ++ str"-" ++ int (loc.ep-loc.bol_pos) ++
+	   str":" ++ fnl())
+
 let ismt = is_empty
 
 (* boxing commands *)
@@ -224,32 +232,15 @@ let qstring s = str "\"" ++ str (escape_string s) ++ str "\""
 let qs = qstring
 let quote s = h 0 (str "\"" ++ s ++ str "\"")
 
-(* This flag tells if the last printed comment ends with a newline, to
-  avoid empty lines *)
-let com_eol = ref false
-
-let com_brk ft = com_eol := false
-let com_if ft f =
-  if !com_eol then (com_eol := false; Format.pp_force_newline ft ())
-  else Lazy.force f
-
 let rec pr_com ft s =
   let (s1,os) =
     try
       let n = String.index s '\n' in
       String.sub s 0 n, Some (String.sub s (n+1) (String.length s - n - 1))
     with Not_found -> s,None in
-  com_if ft (Lazy.from_val());
-(*  let s1 =
-    if String.length s1 <> 0 && s1.[0] = ' ' then
-      (Format.pp_print_space ft (); String.sub s1 1 (String.length s1 - 1))
-    else s1 in*)
   Format.pp_print_as ft (utf8_length s1) s1;
   match os with
-      Some s2 ->
-        if Int.equal (String.length s2) 0 then (com_eol := true)
-        else
-          (Format.pp_force_newline ft (); pr_com ft s2)
+      Some s2 -> Format.pp_force_newline ft (); pr_com ft s2
     | None -> ()
 
 type tag_handler = Tag.t -> Format.tag
@@ -267,30 +258,21 @@ let pp_dirs ?pp_tag ft =
         begin match tok with
         | Str_def s ->
           let n = utf8_length s in
-          com_if ft (Lazy.from_val()); Format.pp_print_as ft n s
+          Format.pp_print_as ft n s
         | Str_len (s, n) ->
-          com_if ft (Lazy.from_val()); Format.pp_print_as ft n s
+          Format.pp_print_as ft n s
         end
     | Ppcmd_box(bty,ss)       -> (* Prevent evaluation of the stream! *)
-        com_if ft (Lazy.from_val());
         pp_open_box bty ;
         if not (Format.over_max_boxes ()) then Glue.iter pp_cmd ss;
         Format.pp_close_box ft ()
-    | Ppcmd_open_box bty      -> com_if ft (Lazy.from_val()); pp_open_box bty
+    | Ppcmd_open_box bty      -> pp_open_box bty
     | Ppcmd_close_box         -> Format.pp_close_box ft ()
-    | Ppcmd_white_space n     ->
-        com_if ft (Lazy.from_fun (fun()->Format.pp_print_break ft n 0))
-    | Ppcmd_print_break(m,n)  ->
-        com_if ft (Lazy.from_fun(fun()->Format.pp_print_break ft m n))
-    | Ppcmd_force_newline     ->
-        com_brk ft; Format.pp_force_newline ft ()
-    | Ppcmd_print_if_broken   ->
-        com_if ft (Lazy.from_fun(fun()->Format.pp_print_if_newline ft ()))
-    | Ppcmd_comment i         ->
-        let coms = split_com [] [] i !comments in
-(*        Format.pp_open_hvbox ft 0;*)
-        List.iter (pr_com ft) coms(*;
-        Format.pp_close_box ft ()*)
+    | Ppcmd_white_space n     -> Format.pp_print_break ft n 0
+    | Ppcmd_print_break(m,n)  -> Format.pp_print_break ft m n
+    | Ppcmd_force_newline     -> Format.pp_force_newline ft ()
+    | Ppcmd_print_if_broken   -> Format.pp_print_if_newline ft ()
+    | Ppcmd_comment coms      -> List.iter (pr_com ft) coms
     | Ppcmd_open_tag tag ->
       begin match pp_tag with
       | None -> ()
@@ -304,13 +286,12 @@ let pp_dirs ?pp_tag ft =
   in
   let pp_dir = function
     | Ppdir_ppcmds cmdstream -> Glue.iter pp_cmd cmdstream
-    | Ppdir_print_newline    ->
-        com_brk ft; Format.pp_print_newline ft ()
+    | Ppdir_print_newline    -> Format.pp_print_newline ft ()
     | Ppdir_print_flush      -> Format.pp_print_flush ft ()
   in
   fun (dirstream : _ ppdirs) ->
     try
-      Glue.iter pp_dir dirstream; com_brk ft
+      Glue.iter pp_dir dirstream
     with reraise ->
       let reraise = Backtrace.add_backtrace reraise in
       let () = Format.pp_print_flush ft () in
@@ -321,8 +302,8 @@ let pp_with ?pp_tag ft strm =
   pp_dirs ?pp_tag ft (Glue.atom (Ppdir_ppcmds strm))
 
 (* pretty printing functions WITH FLUSH *)
-let msg_with ft strm =
-  pp_dirs ft (Glue.atom(Ppdir_ppcmds strm) ++ Glue.atom(Ppdir_print_flush))
+let msg_with ?pp_tag ft strm =
+  pp_dirs ?pp_tag ft (Glue.atom(Ppdir_ppcmds strm) ++ Glue.atom(Ppdir_print_flush))
 
 (* If mixing some output and a goal display, please use msg_warning,
    so that interfaces (proofgeneral for example) can easily dispatch
@@ -330,7 +311,7 @@ let msg_with ft strm =
 
 (** Output to a string formatter *)
 let string_of_ppcmds c =
-  Format.fprintf Format.str_formatter "@[%a@]" msg_with c;
+  Format.fprintf Format.str_formatter "@[%a@]" (msg_with ?pp_tag:None) c;
   Format.flush_str_formatter ()
 
 (* Copy paste from Util *)
diff --git a/lib/pp.mli b/lib/pp.mli
index d7ab5cc96..f17908262 100644
--- a/lib/pp.mli
+++ b/lib/pp.mli
@@ -21,8 +21,7 @@ val ws    : int -> std_ppcmds
 val mt    : unit -> std_ppcmds
 val ismt  : std_ppcmds -> bool
 
-val comment  : int -> std_ppcmds
-val comments : ((int * int) * string) list ref
+val comment  : string list -> std_ppcmds
 
 (** {6 Manipulation commands} *)
 
@@ -161,9 +160,15 @@ val surround : std_ppcmds -> std_ppcmds
 
 val pr_vertical_list : ('b -> std_ppcmds) -> 'b list -> std_ppcmds
 
+val pr_loc : Loc.t -> std_ppcmds
+
 (** {6 Low-level pretty-printing functions with and without flush} *)
 
 (** FIXME: These ignore the logging settings and call [Format] directly *)
 type tag_handler = Tag.t -> Format.tag
-val msg_with :                        Format.formatter -> std_ppcmds -> unit
+
+(** [msg_with ?pp_tag fmt pp] Print [pp] to [fmt] and flush [fmt]  *)
+val msg_with : ?pp_tag:tag_handler -> Format.formatter -> std_ppcmds -> unit
+
+(** [msg_with ?pp_tag fmt pp] Print [pp] to [fmt] and don't flush [fmt]  *)
 val pp_with  : ?pp_tag:tag_handler -> Format.formatter -> std_ppcmds -> unit
diff --git a/lib/ppstyle.ml b/lib/ppstyle.ml
index b068788c9..aa47c5167 100644
--- a/lib/ppstyle.ml
+++ b/lib/ppstyle.ml
@@ -56,41 +56,6 @@ let default = Terminal.({
 
 let empty = Terminal.make ()
 
-let make_style_stack style_tags =
-  (** Not thread-safe. We should put a lock somewhere if we print from
-      different threads. Do we? *)
-  let style_stack = ref [] in
-  let peek () = match !style_stack with
-  | [] -> default (** Anomalous case, but for robustness *)
-  | st :: _ -> st
-  in
-  let push tag =
-    let style =
-      try
-        begin match String.Map.find tag style_tags with
-        | None -> empty
-        | Some st -> st
-        end
-      with Not_found -> empty
-    in
-    (** Use the merging of the latest tag and the one being currently pushed.
-    This may be useful if for instance the latest tag changes the background and
-    the current one the foreground, so that the two effects are additioned. *)
-    let style = Terminal.merge (peek ()) style in
-    let () = style_stack := style :: !style_stack in
-    Terminal.eval style
-  in
-  let pop _ = match !style_stack with
-  | [] ->
-    (** Something went wrong, we fallback *)
-    Terminal.eval default
-  | _ :: rem ->
-    let () = style_stack := rem in
-    Terminal.eval (peek ())
-  in
-  let clear () = style_stack := [] in
-  push, pop, clear
-
 let error_tag =
   let style = Terminal.make ~bold:true ~fg_color:`WHITE ~bg_color:`RED () in
   make ~style ["message"; "error"]
@@ -106,36 +71,3 @@ let debug_tag =
 let pp_tag t = match Pp.Tag.prj t tag with
 | None -> ""
 | Some key -> key
-
-let clear_tag_fn = ref (fun () -> ())
-
-let init_color_output () =
-  let push_tag, pop_tag, clear_tag = make_style_stack !tags in
-  clear_tag_fn := clear_tag;
-  let tag_handler = {
-    Format.mark_open_tag = push_tag;
-    Format.mark_close_tag = pop_tag;
-    Format.print_open_tag = ignore;
-    Format.print_close_tag = ignore;
-  } in
-  let open Pp_control in
-  Format.pp_set_mark_tags !std_ft true;
-  Format.pp_set_mark_tags !err_ft true;
-  Format.pp_set_formatter_tag_functions !std_ft tag_handler;
-  Format.pp_set_formatter_tag_functions !err_ft tag_handler
-
-let color_msg ?header ft strm =
-  let pptag = tag in
-  let open Pp in
-  let strm = match header with
-    | None -> hov 0 strm
-    | Some (h, t) ->
-      let tag = Pp.Tag.inj t pptag in
-      let h = Pp.tag tag (str h ++ str ":") in
-      hov 0 (h ++ spc () ++ strm)
-  in
-  pp_with ~pp_tag ft strm;
-  Format.pp_print_newline ft ();
-  Format.pp_print_flush ft ();
-  (** In case something went wrong, we reset the stack *)
-  !clear_tag_fn ()
diff --git a/lib/ppstyle.mli b/lib/ppstyle.mli
index 1cd701ed4..d9fd75765 100644
--- a/lib/ppstyle.mli
+++ b/lib/ppstyle.mli
@@ -44,14 +44,7 @@ val parse_config : string -> unit
 val dump : unit -> (t * Terminal.style option) list
 (** Recover the list of known tags together with their current style. *)
 
-(** {5 Setting color output} *)
-
-val init_color_output : unit -> unit
-
-val color_msg : ?header:string * Format.tag ->
-  Format.formatter -> Pp.std_ppcmds -> unit
-(** {!color_msg ?header fmt pp} will format according to the tags
-     defined in this file *)
+(** {5 Color output} *)
 
 val pp_tag : Pp.tag_handler
 (** Returns the name of a style tag that is understandable by the formatters
diff --git a/lib/profile.ml b/lib/profile.ml
index 2350cd43a..d620fe69c 100644
--- a/lib/profile.ml
+++ b/lib/profile.ml
@@ -146,9 +146,9 @@ let merge_profile filename (curr_table, curr_outside, curr_total as new_data) =
    number of allocated bytes may exceed the maximum integer capacity
    (2^31 on 32-bits architectures);  therefore, allocation is measured
    by small steps, total allocations are computed by adding elementary
-   measures and carries are controled from step to step *)
+   measures and carries are controlled from step to step *)
 
-(* Unix measure of time is approximative and shoitt delays are often
+(* Unix measure of time is approximate and short delays are often
    unperceivable; therefore, total times are measured in one (big)
    step to avoid rounding errors and to get the best possible
    approximation.
@@ -260,7 +260,7 @@ let time_overhead_B_C () =
       let _dw = dummy_spent_alloc () in
       let _dt = get_time () in
       ()
-    with e when Errors.noncritical e -> assert false
+    with e when CErrors.noncritical e -> assert false
   done;
   let after = get_time () in
   let beforeloop =  get_time () in
@@ -358,7 +358,7 @@ let declare_profile name =
   prof_table := (name,e)::!prof_table;
   e
 
-(* Default initialisation, may be overriden *)
+(* Default initialization, may be overridden *)
 let _ = init_profile ()
 
 (******************************)
diff --git a/lib/remoteCounter.ml b/lib/remoteCounter.ml
index 3f1982594..e7646fb79 100644
--- a/lib/remoteCounter.ml
+++ b/lib/remoteCounter.ml
@@ -20,19 +20,21 @@ let new_counter ~name a ~incr ~build =
   let data = ref (ref a) in
   counters := (name, Obj.repr data) :: !counters;
   let m = Mutex.create () in
-  let mk_thsafe_getter f () =
+  let mk_thsafe_local_getter f () =
     (* - slaves must use a remote counter getter, not this one! *)
     (* - in the main process there is a race condition between slave
          managers (that are threads) and the main thread, hence the mutex *)
     if Flags.async_proofs_is_worker () then
-      Errors.anomaly(Pp.str"Slave processes must install remote counters");
+      CErrors.anomaly(Pp.str"Slave processes must install remote counters");
     Mutex.lock m; let x = f () in Mutex.unlock m;
     build x in
-  let getter = ref(mk_thsafe_getter (fun () -> !data := incr !!data; !!data)) in
+  let mk_thsafe_remote_getter f () =
+    Mutex.lock m; let x = f () in Mutex.unlock m; x in
+  let getter = ref(mk_thsafe_local_getter (fun () -> !data := incr !!data; !!data)) in
   let installer f =
     if not (Flags.async_proofs_is_worker ()) then
-      Errors.anomaly(Pp.str"Only slave processes can install a remote counter");
-    getter := f in
+      CErrors.anomaly(Pp.str"Only slave processes can install a remote counter");
+    getter := mk_thsafe_remote_getter f in
   (fun () -> !getter ()), installer
 
 let backup () = !counters
diff --git a/lib/richpp.ml b/lib/richpp.ml
index fe3edd99c..d1c6d158e 100644
--- a/lib/richpp.ml
+++ b/lib/richpp.ml
@@ -55,7 +55,7 @@ let rich_pp annotate ppcmds =
     string_of_int index
   in
 
-  let pp_buffer = Buffer.create 13 in
+  let pp_buffer = Buffer.create 180 in
 
   let push_pcdata () =
     (** Push the optional PCData on the above node *)
@@ -113,6 +113,13 @@ let rich_pp annotate ppcmds =
   pp_set_formatter_tag_functions ft tag_functions;
   pp_set_mark_tags ft true;
 
+  (* Set formatter width. This is currently a hack and duplicate code
+     with Pp_control. Hopefully it will be fixed better in Coq 8.7 *)
+  let w = pp_get_margin str_formatter () in
+  let m = max (64 * w / 100) (w-30) in
+  pp_set_margin ft w;
+  pp_set_max_indent ft m;
+
   (** The whole output must be a valid document. To that
       end, we nest the document inside <pp> tags. *)
   pp_open_tag ft "pp";
@@ -194,7 +201,3 @@ let raw_print xml =
   let () = print xml in
   Buffer.contents buf
 
-let of_richpp x = Element ("richpp", [], [x])
-let to_richpp xml = match xml with
-| Element ("richpp", [], [x]) -> x
-| _ -> raise Serialize.Marshal_error
diff --git a/lib/richpp.mli b/lib/richpp.mli
index 807d52aba..287d265a8 100644
--- a/lib/richpp.mli
+++ b/lib/richpp.mli
@@ -57,10 +57,7 @@ val richpp_of_string : string -> richpp
 val repr : richpp -> Xml_datatype.xml
 (** Observe the styled text as XML *)
 
-(** {5 Serialization} *)
-
-val of_richpp : richpp -> Xml_datatype.xml
-val to_richpp : Xml_datatype.xml -> richpp
+(** {5 Debug/Compat} *)
 
 (** Represent the semi-structured document as a string, dropping any additional
     information. *)
diff --git a/lib/spawn.ml b/lib/spawn.ml
index 2b9c4ccac..479176973 100644
--- a/lib/spawn.ml
+++ b/lib/spawn.ml
@@ -43,7 +43,7 @@ module type MainLoopModel = sig
 end
 
 (* Common code *)
-let assert_ b s = if not b then Errors.anomaly (Pp.str s)
+let assert_ b s = if not b then CErrors.anomaly (Pp.str s)
 
 (* According to http://caml.inria.fr/mantis/view.php?id=5325
  * you can't use the same socket for both writing and reading (may change
@@ -192,7 +192,7 @@ let spawn ?(prefer_sock=prefer_sock) ?(env=Unix.environment ())
         let live = callback cl ~read_all:(fun () -> ML.read_all gchan) in
         if not live then kill p;
         live
-      with e when Errors.noncritical e ->
+      with e when CErrors.noncritical e ->
         pr_err ("Async reader raised: " ^ (Printexc.to_string e));
         kill p;
         false) gchan
diff --git a/lib/stateid.ml b/lib/stateid.ml
index 59cf206e2..ae25735c5 100644
--- a/lib/stateid.ml
+++ b/lib/stateid.ml
@@ -6,8 +6,6 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-open Xml_datatype
-
 type t = int
 let initial = 1
 let dummy = 0
@@ -15,29 +13,29 @@ let fresh, in_range =
   let cur = ref initial in
   (fun () -> incr cur; !cur), (fun id -> id >= 0 && id <= !cur)
 let to_string = string_of_int
-let of_int id = assert(in_range id); id
+let of_int id =
+  (* Coqide too to parse ids too, but cannot check if they are valid.
+   * Hence we check for validity only if we are an ide slave. *)
+  if !Flags.ide_slave then assert (in_range id);
+  id
 let to_int id = id
 let newer_than id1 id2 = id1 > id2
 
-let of_xml = function
-  | Element ("state_id",["val",i],[]) ->
-      let id = int_of_string i in
-      (* Coqide too to parse ids too, but cannot check if they are valid.
-       * Hence we check for validity only if we are an ide slave. *)
-      if !Flags.ide_slave then assert(in_range id);
-      id
-  | _ -> raise (Invalid_argument "to_state_id")
-let to_xml i = Element ("state_id",["val",string_of_int i],[])
-
 let state_id_info : (t * t) Exninfo.t = Exninfo.make ()
-let add exn ?(valid = initial) id =
+let add exn ~valid id =
   Exninfo.add exn state_id_info (valid, id)
 let get exn = Exninfo.get exn state_id_info
 
 let equal = Int.equal
 let compare = Int.compare
 
-module Set = Set.Make(struct type t = int let compare = compare end)
+module Self = struct
+ type t = int
+ let compare = compare
+ let equal = equal
+end
+
+module Set = Set.Make(Self)
 
 type ('a,'b) request = {
   exn_info : t * t;
diff --git a/lib/stateid.mli b/lib/stateid.mli
index 2c12c30c3..1d87a343b 100644
--- a/lib/stateid.mli
+++ b/lib/stateid.mli
@@ -6,32 +6,28 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-open Xml_datatype
-
 type t
 
 val equal : t -> t -> bool
 val compare : t -> t -> int
 
-module Set : Set.S with type elt = t
+module Self : Map.OrderedType with type t = t
+module Set : Set.S with type elt = t and type t = Set.Make(Self).t
 
 val initial : t
 val dummy : t
 val fresh : unit -> t
 val to_string : t -> string
+
 val of_int : int -> t
 val to_int : t -> int
-val newer_than : t -> t -> bool
 
-(* XML marshalling *)
-val to_xml : t -> xml
-val of_xml : xml -> t
+val newer_than : t -> t -> bool
 
 (* Attaches to an exception the concerned state id, plus an optional
  * state id that is a valid state id before the error.
- * Backtracking to the valid id is safe.
- * The initial_state_id is assumed to be safe. *)
-val add : Exninfo.info -> ?valid:t -> t -> Exninfo.info
+ * Backtracking to the valid id is safe. *)
+val add : Exninfo.info -> valid:t -> t -> Exninfo.info
 val get : Exninfo.info -> (t * t) option
 
 type ('a,'b) request = {
diff --git a/lib/system.ml b/lib/system.ml
index 8b53a11d6..e0e2c829d 100644
--- a/lib/system.ml
+++ b/lib/system.ml
@@ -9,7 +9,6 @@
 (* $Id$ *)
 
 open Pp
-open Errors
 open Util
 
 include Minisys
@@ -18,6 +17,10 @@ include Minisys
     depth-first search, with sons ordered as on the file system;
     warns if [root] does not exist *)
 
+let warn_cannot_open_dir =
+  CWarnings.create ~name:"cannot-open-dir" ~category:"filesystem"
+  (fun dir -> str ("Cannot open directory " ^ dir))
+
 let all_subdirs ~unix_path:root =
   let l = ref [] in
   let add f rel = l := (f, rel) :: !l in
@@ -30,9 +33,8 @@ let all_subdirs ~unix_path:root =
       | _ -> ()
     in process_directory f path
   in
-  check_unix_dir (fun s -> Feedback.msg_warning (str s)) root;
   if exists_dir root then traverse root []
-  else Feedback.msg_warning (str ("Cannot open " ^ root));
+  else warn_cannot_open_dir root;
   List.rev !l
 
 (* Caching directory contents for efficient syntactic equality of file
@@ -85,19 +87,22 @@ let rec search paths test =
   | [] -> []
   | lpe :: rem -> test lpe @ search rem test
 
+let warn_ambiguous_file_name =
+  CWarnings.create ~name:"ambiguous-file-name" ~category:"filesystem"
+    (fun (filename,l,f) -> str filename ++ str " has been found in" ++ spc () ++
+                hov 0 (str "[ " ++
+                         hv 0 (prlist_with_sep (fun () -> str " " ++ pr_semicolon())
+                                               (fun (lpe,_) -> str lpe) l)
+                       ++ str " ];") ++ fnl () ++
+                str "loading " ++ str f)
+
+
 let where_in_path ?(warn=true) path filename =
   let check_and_warn l = match l with
   | [] -> raise Not_found
   | (lpe, f) :: l' ->
     let () = match l' with
-    | _ :: _ when warn ->
-      Feedback.msg_warning
-        (str filename ++ str " has been found in" ++ spc () ++
-          hov 0 (str "[ " ++
-            hv 0 (prlist_with_sep (fun () -> str " " ++ pr_semicolon())
-              (fun (lpe,_) -> str lpe) l)
-            ++ str " ];") ++ fnl () ++
-          str "loading " ++ str f)
+    | _ :: _ when warn -> warn_ambiguous_file_name (filename,l,f)
     | _ -> ()
     in
     (lpe, f)
@@ -126,7 +131,7 @@ let find_file_in_path ?(warn=true) paths filename =
       let root = Filename.dirname filename in
       root, filename
     else
-      errorlabstrm "System.find_file_in_path"
+      CErrors.user_err ~hdr:"System.find_file_in_path"
 	(hov 0 (str "Can't find file" ++ spc () ++ str filename))
   else
     (* the name is considered to be the transcription as a relative
@@ -134,7 +139,7 @@ let find_file_in_path ?(warn=true) paths filename =
        to be locate respecting case *)
     try where_in_path ~warn paths filename
     with Not_found ->
-      errorlabstrm "System.find_file_in_path"
+      CErrors.user_err ~hdr:"System.find_file_in_path"
 	(hov 0 (str "Can't find file" ++ spc () ++ str filename ++ spc () ++
 		str "on loadpath"))
 
@@ -142,27 +147,34 @@ let is_in_path lpath filename =
   try ignore (where_in_path ~warn:false lpath filename); true
   with Not_found -> false
 
+let warn_path_not_found =
+  CWarnings.create ~name:"path-not-found" ~category:"filesystem"
+  (fun () -> str "system variable PATH not found")
+
 let is_in_system_path filename =
   try
     let lpath = CUnix.path_to_list (Sys.getenv "PATH") in
     is_in_path lpath filename
   with Not_found ->
-    Feedback.msg_warning (str "system variable PATH not found");
+    warn_path_not_found ();
     false
 
 let open_trapping_failure name =
   try open_out_bin name
-  with e when Errors.noncritical e ->
-    errorlabstrm "System.open" (str "Can't open " ++ str name)
+  with e when CErrors.noncritical e ->
+    CErrors.user_err ~hdr:"System.open" (str "Can't open " ++ str name)
+
+let warn_cannot_remove_file =
+  CWarnings.create ~name:"cannot-remove-file" ~category:"filesystem"
+  (fun filename -> str"Could not remove file " ++ str filename ++ str" which is corrupted!")
 
 let try_remove filename =
   try Sys.remove filename
-  with e when Errors.noncritical e ->
-    Feedback.msg_warning
-      (str"Could not remove file " ++ str filename ++ str" which is corrupted!")
+  with e when CErrors.noncritical e ->
+    warn_cannot_remove_file filename
 
 let error_corrupted file s =
-  errorlabstrm "System" (str file ++ str ": " ++ str s ++ str ". Try to rebuild it.")
+  CErrors.user_err ~hdr:"System" (str file ++ str ": " ++ str s ++ str ". Try to rebuild it.")
 
 let input_binary_int f ch =
   try input_binary_int ch
@@ -235,11 +247,11 @@ let extern_state magic filename val_0 =
       marshal_out channel val_0;
       close_out channel
     with reraise ->
-      let reraise = Errors.push reraise in
+      let reraise = CErrors.push reraise in
       let () = try_remove filename in
       iraise reraise
   with Sys_error s ->
-    errorlabstrm "System.extern_state" (str "System error: " ++ str s)
+    CErrors.user_err ~hdr:"System.extern_state" (str "System error: " ++ str s)
 
 let intern_state magic filename =
   try
@@ -248,12 +260,12 @@ let intern_state magic filename =
     close_in channel;
     v
   with Sys_error s ->
-    errorlabstrm "System.intern_state" (str "System error: " ++ str s)
+    CErrors.user_err ~hdr:"System.intern_state" (str "System error: " ++ str s)
 
 let with_magic_number_check f a =
   try f a
   with Bad_magic_number {filename=fname;actual=actual;expected=expected} ->
-    errorlabstrm "with_magic_number_check"
+    CErrors.user_err ~hdr:"with_magic_number_check"
     (str"File " ++ str fname ++ strbrk" has bad magic number " ++
     int actual ++ str" (expected " ++ int expected ++ str")." ++
     spc () ++
@@ -297,6 +309,7 @@ let with_time time f x =
     raise e
 
 let process_id () =
-  if Flags.async_proofs_is_worker () then !Flags.async_proofs_worker_id
-  else Printf.sprintf "master:%d" (Thread.id (Thread.self ()))
-    
+  Printf.sprintf "%d:%s:%d" (Unix.getpid ())
+    (if Flags.async_proofs_is_worker () then !Flags.async_proofs_worker_id
+     else "master")
+    (Thread.id (Thread.self ()))
diff --git a/lib/system.mli b/lib/system.mli
index 4dbb3695d..214369095 100644
--- a/lib/system.mli
+++ b/lib/system.mli
@@ -20,11 +20,6 @@ val (//) : unix_path -> string -> unix_path
 
 val exists_dir : unix_path -> bool
 
-(** [check_unix_dir warn path] calls [warn] with an appropriate
-     message if [path] looks does not look like a Unix path on Windows *)
-
-val check_unix_dir : (string -> unit) -> unix_path -> unit
-
 (** [exclude_search_in_dirname path] excludes [path] when processing
     directories *)
 
diff --git a/lib/unicode.ml b/lib/unicode.ml
index 7aa8d9d51..959ccaf73 100644
--- a/lib/unicode.ml
+++ b/lib/unicode.ml
@@ -8,9 +8,7 @@
 
 (** Unicode utilities *)
 
-type status = Letter | IdentPart | Symbol
-
-exception Unsupported
+type status = Letter | IdentPart | Symbol | Unknown
 
 (* The following table stores classes of Unicode characters that
    are used by the lexer. There are 3 different classes so 2 bits are
@@ -29,6 +27,7 @@ let mask i = function
   | Letter    -> 1 lsl ((i land 7) lsl 1) (* 01 *)
   | IdentPart -> 2 lsl ((i land 7) lsl 1) (* 10 *)
   | Symbol    -> 3 lsl ((i land 7) lsl 1) (* 11 *)
+  | Unknown   -> 0 lsl ((i land 7) lsl 1) (* 00 *)
 
 (* Helper to reset 2 bits in a word. *)
 let reset_mask i =
@@ -55,7 +54,7 @@ let lookup x =
     if      v = 1 then Letter
     else if v = 2 then IdentPart
     else if v = 3 then Symbol
-    else raise Unsupported
+    else Unknown
 
 (* [classify] discriminates between 3 different kinds of
    symbols based on the standard unicode classification (extracted from
@@ -125,27 +124,11 @@ exception End_of_input
 let utf8_of_unicode n =
   if n < 128 then
     String.make 1 (Char.chr n)
-  else if n < 2048 then
-    let s = String.make 2 (Char.chr (128 + n mod 64)) in
-    begin
-      s.[0] <- Char.chr (192 + n / 64);
-      s
-    end
-  else if n < 65536 then
-    let s = String.make 3 (Char.chr (128 + n mod 64)) in
-    begin
-      s.[1] <- Char.chr (128 + (n / 64) mod 64);
-      s.[0] <- Char.chr (224 + n / 4096);
-      s
-    end
   else
-    let s = String.make 4 (Char.chr (128 + n mod 64)) in
-    begin
-      s.[2] <- Char.chr (128 + (n / 64) mod 64);
-      s.[1] <- Char.chr (128 + (n / 4096) mod 64);
-      s.[0] <- Char.chr (240 + n / 262144);
-      s
-    end
+    let (m,s) = if n < 2048 then (2,192) else if n < 65536 then (3,224) else (4,240) in
+    String.init m (fun i ->
+        let j = (n lsr ((m - 1 - i) * 6)) land 63 in
+        Char.chr (j + if i = 0 then s else 128))
 
 (* If [s] is some UTF-8 encoded string
    and [i] is a position of some UTF-8 character within [s]
@@ -215,7 +198,6 @@ let ident_refutation s =
         |x -> x
   with
   | End_of_input -> Some (true,"The empty string is not an identifier.")
-  | Unsupported -> Some (true,s^": unsupported character in utf8 sequence.")
   | Invalid_argument _ -> Some (true,s^": invalid utf8 sequence.")
 
 let lowercase_unicode =
@@ -261,3 +243,73 @@ let ascii_of_ident s =
         (Buffer.add_char out s.[!i]; incr i)
     done;
     Buffer.contents out
+
+(* Compute length of an UTF-8 encoded string
+   Rem 1 : utf8_length <= String.length (equal if pure ascii)
+   Rem 2 : if used for an iso8859_1 encoded string, the result is
+   wrong in very rare cases. Such a wrong case corresponds to any
+   sequence of a character in range 192..253 immediately followed by a
+   character in range 128..191 (typical case in french is "déçu" which
+   is counted 3 instead of 4); then no real harm to use always
+   utf8_length even if using an iso8859_1 encoding *)
+
+(** FIXME: duplicate code with Pp *)
+
+let utf8_length s =
+  let len = String.length s
+  and cnt = ref 0
+  and nc = ref 0
+  and p = ref 0 in
+  while !p < len do
+    begin
+      match s.[!p] with
+      | '\000'..'\127' -> nc := 0 (* ascii char *)
+      | '\128'..'\191' -> nc := 0 (* cannot start with a continuation byte *)
+      | '\192'..'\223' -> nc := 1 (* expect 1 continuation byte *)
+      | '\224'..'\239' -> nc := 2 (* expect 2 continuation bytes *)
+      | '\240'..'\247' -> nc := 3 (* expect 3 continuation bytes *)
+      | '\248'..'\251' -> nc := 4 (* expect 4 continuation bytes *)
+      | '\252'..'\253' -> nc := 5 (* expect 5 continuation bytes *)
+      | '\254'..'\255' -> nc := 0 (* invalid byte *)
+    end ;
+    incr p ;
+    while !p < len && !nc > 0 do
+      match s.[!p] with
+      | '\128'..'\191' (* next continuation byte *) -> incr p ; decr nc
+      | _ (* not a continuation byte *) -> nc := 0
+    done ;
+    incr cnt
+  done ;
+  !cnt
+
+(* Variant of String.sub for UTF8 character positions *)
+let utf8_sub s start_u len_u =
+  let len_b = String.length s
+  and end_u = start_u + len_u
+  and cnt = ref 0
+  and nc = ref 0
+  and p = ref 0 in
+  let start_b = ref len_b in
+  while !p < len_b && !cnt < end_u do
+    if !cnt <= start_u then start_b := !p ;
+    begin
+      match s.[!p] with
+      | '\000'..'\127' -> nc := 0 (* ascii char *)
+      | '\128'..'\191' -> nc := 0 (* cannot start with a continuation byte *)
+      |	'\192'..'\223' -> nc := 1 (* expect 1 continuation byte *)
+      |	'\224'..'\239' -> nc := 2 (* expect 2 continuation bytes *)
+      |	'\240'..'\247' -> nc := 3 (* expect 3 continuation bytes *)
+      |	'\248'..'\251' -> nc := 4 (* expect 4 continuation bytes *)
+      |	'\252'..'\253' -> nc := 5 (* expect 5 continuation bytes *)
+      |	'\254'..'\255' -> nc := 0 (* invalid byte *)
+    end ;
+    incr p ;
+    while !p < len_b && !nc > 0 do
+      match s.[!p] with
+      |	'\128'..'\191' (* next continuation byte *) -> incr p ; decr nc
+      |	_ (* not a continuation byte *) -> nc := 0
+    done ;
+    incr cnt
+  done ;
+  let end_b = !p in
+  String.sub s !start_b (end_b - !start_b)
diff --git a/lib/unicode.mli b/lib/unicode.mli
index aaf455dec..2609e1968 100644
--- a/lib/unicode.mli
+++ b/lib/unicode.mli
@@ -8,22 +8,16 @@
 
 (** Unicode utilities *)
 
-type status = Letter | IdentPart | Symbol
+type status = Letter | IdentPart | Symbol | Unknown
 
-(** This exception is raised when UTF-8 the input string contains unsupported UTF-8 characters. *)
-exception Unsupported
-
-(** Classify a unicode char into 3 classes.
-    @raise Unsupported if the input string contains unsupported UTF-8 characters. *)
+(** Classify a unicode char into 3 classes or unknown. *)
 val classify : int -> status
 
 (** Return [None] if a given string can be used as a (Coq) identifier.
-    Return [Some (b,s)] otherwise, where [s] is an explanation and [b] is severity.
-    @raise Unsupported if the input string contains unsupported UTF-8 characters. *)
+    Return [Some (b,s)] otherwise, where [s] is an explanation and [b] is severity. *)
 val ident_refutation : string -> (bool * string) option
 
 (** First char of a string, converted to lowercase
-    @raise Unsupported if the input string contains unsupported UTF-8 characters.
     @raise Assert_failure if the input string is empty. *)
 val lowercase_first_char : string -> string
 
@@ -40,3 +34,9 @@ val ascii_of_ident : string -> string
 
 (** Validate an UTF-8 string *)
 val is_utf8 : string -> bool
+
+(** Return the length of a valid UTF-8 string. *)
+val utf8_length : string -> int
+
+(** Variant of {!String.sub} for UTF-8 strings. *)
+val utf8_sub : string -> int -> int -> string
diff --git a/lib/unicodetable.ml b/lib/unicodetable.ml
index f4e978d69..b607058c6 100644
--- a/lib/unicodetable.ml
+++ b/lib/unicodetable.ml
@@ -1,5 +1,4 @@
-
-(** Unicode tables generated from Camomile. *)
+(** Unicode tables generated using UUCD. *)
 
 (* Letter, Uppercase *)
 let lu = [
@@ -139,12 +138,25 @@ let lu = [
   (0x0022E,0x0022E);
   (0x00230,0x00230);
   (0x00232,0x00232);
+  (0x0023A,0x0023B);
+  (0x0023D,0x0023E);
+  (0x00241,0x00241);
+  (0x00243,0x00246);
+  (0x00248,0x00248);
+  (0x0024A,0x0024A);
+  (0x0024C,0x0024C);
+  (0x0024E,0x0024E);
+  (0x00370,0x00370);
+  (0x00372,0x00372);
+  (0x00376,0x00376);
+  (0x0037F,0x0037F);
   (0x00386,0x00386);
   (0x00388,0x0038A);
   (0x0038C,0x0038C);
   (0x0038E,0x0038F);
   (0x00391,0x003A1);
   (0x003A3,0x003AB);
+  (0x003CF,0x003CF);
   (0x003D2,0x003D4);
   (0x003D8,0x003D8);
   (0x003DA,0x003DA);
@@ -159,7 +171,9 @@ let lu = [
   (0x003EC,0x003EC);
   (0x003EE,0x003EE);
   (0x003F4,0x003F4);
-  (0x00400,0x0042F);
+  (0x003F7,0x003F7);
+  (0x003F9,0x003FA);
+  (0x003FD,0x0042F);
   (0x00460,0x00460);
   (0x00462,0x00462);
   (0x00464,0x00464);
@@ -230,7 +244,11 @@ let lu = [
   (0x004F0,0x004F0);
   (0x004F2,0x004F2);
   (0x004F4,0x004F4);
+  (0x004F6,0x004F6);
   (0x004F8,0x004F8);
+  (0x004FA,0x004FA);
+  (0x004FC,0x004FC);
+  (0x004FE,0x004FE);
   (0x00500,0x00500);
   (0x00502,0x00502);
   (0x00504,0x00504);
@@ -239,8 +257,27 @@ let lu = [
   (0x0050A,0x0050A);
   (0x0050C,0x0050C);
   (0x0050E,0x0050E);
+  (0x00510,0x00510);
+  (0x00512,0x00512);
+  (0x00514,0x00514);
+  (0x00516,0x00516);
+  (0x00518,0x00518);
+  (0x0051A,0x0051A);
+  (0x0051C,0x0051C);
+  (0x0051E,0x0051E);
+  (0x00520,0x00520);
+  (0x00522,0x00522);
+  (0x00524,0x00524);
+  (0x00526,0x00526);
+  (0x00528,0x00528);
+  (0x0052A,0x0052A);
+  (0x0052C,0x0052C);
+  (0x0052E,0x0052E);
   (0x00531,0x00556);
   (0x010A0,0x010C5);
+  (0x010C7,0x010C7);
+  (0x010CD,0x010CD);
+  (0x013A0,0x013F5);
   (0x01E00,0x01E00);
   (0x01E02,0x01E02);
   (0x01E04,0x01E04);
@@ -316,6 +353,7 @@ let lu = [
   (0x01E90,0x01E90);
   (0x01E92,0x01E92);
   (0x01E94,0x01E94);
+  (0x01E9E,0x01E9E);
   (0x01EA0,0x01EA0);
   (0x01EA2,0x01EA2);
   (0x01EA4,0x01EA4);
@@ -361,6 +399,9 @@ let lu = [
   (0x01EF4,0x01EF4);
   (0x01EF6,0x01EF6);
   (0x01EF8,0x01EF8);
+  (0x01EFA,0x01EFA);
+  (0x01EFC,0x01EFC);
+  (0x01EFE,0x01EFE);
   (0x01F08,0x01F0F);
   (0x01F18,0x01F1D);
   (0x01F28,0x01F2F);
@@ -386,12 +427,176 @@ let lu = [
   (0x02126,0x02126);
   (0x02128,0x02128);
   (0x0212A,0x0212D);
-  (0x02130,0x02131);
-  (0x02133,0x02133);
+  (0x02130,0x02133);
   (0x0213E,0x0213F);
   (0x02145,0x02145);
+  (0x02183,0x02183);
+  (0x02C00,0x02C2E);
+  (0x02C60,0x02C60);
+  (0x02C62,0x02C64);
+  (0x02C67,0x02C67);
+  (0x02C69,0x02C69);
+  (0x02C6B,0x02C6B);
+  (0x02C6D,0x02C70);
+  (0x02C72,0x02C72);
+  (0x02C75,0x02C75);
+  (0x02C7E,0x02C80);
+  (0x02C82,0x02C82);
+  (0x02C84,0x02C84);
+  (0x02C86,0x02C86);
+  (0x02C88,0x02C88);
+  (0x02C8A,0x02C8A);
+  (0x02C8C,0x02C8C);
+  (0x02C8E,0x02C8E);
+  (0x02C90,0x02C90);
+  (0x02C92,0x02C92);
+  (0x02C94,0x02C94);
+  (0x02C96,0x02C96);
+  (0x02C98,0x02C98);
+  (0x02C9A,0x02C9A);
+  (0x02C9C,0x02C9C);
+  (0x02C9E,0x02C9E);
+  (0x02CA0,0x02CA0);
+  (0x02CA2,0x02CA2);
+  (0x02CA4,0x02CA4);
+  (0x02CA6,0x02CA6);
+  (0x02CA8,0x02CA8);
+  (0x02CAA,0x02CAA);
+  (0x02CAC,0x02CAC);
+  (0x02CAE,0x02CAE);
+  (0x02CB0,0x02CB0);
+  (0x02CB2,0x02CB2);
+  (0x02CB4,0x02CB4);
+  (0x02CB6,0x02CB6);
+  (0x02CB8,0x02CB8);
+  (0x02CBA,0x02CBA);
+  (0x02CBC,0x02CBC);
+  (0x02CBE,0x02CBE);
+  (0x02CC0,0x02CC0);
+  (0x02CC2,0x02CC2);
+  (0x02CC4,0x02CC4);
+  (0x02CC6,0x02CC6);
+  (0x02CC8,0x02CC8);
+  (0x02CCA,0x02CCA);
+  (0x02CCC,0x02CCC);
+  (0x02CCE,0x02CCE);
+  (0x02CD0,0x02CD0);
+  (0x02CD2,0x02CD2);
+  (0x02CD4,0x02CD4);
+  (0x02CD6,0x02CD6);
+  (0x02CD8,0x02CD8);
+  (0x02CDA,0x02CDA);
+  (0x02CDC,0x02CDC);
+  (0x02CDE,0x02CDE);
+  (0x02CE0,0x02CE0);
+  (0x02CE2,0x02CE2);
+  (0x02CEB,0x02CEB);
+  (0x02CED,0x02CED);
+  (0x02CF2,0x02CF2);
+  (0x0A640,0x0A640);
+  (0x0A642,0x0A642);
+  (0x0A644,0x0A644);
+  (0x0A646,0x0A646);
+  (0x0A648,0x0A648);
+  (0x0A64A,0x0A64A);
+  (0x0A64C,0x0A64C);
+  (0x0A64E,0x0A64E);
+  (0x0A650,0x0A650);
+  (0x0A652,0x0A652);
+  (0x0A654,0x0A654);
+  (0x0A656,0x0A656);
+  (0x0A658,0x0A658);
+  (0x0A65A,0x0A65A);
+  (0x0A65C,0x0A65C);
+  (0x0A65E,0x0A65E);
+  (0x0A660,0x0A660);
+  (0x0A662,0x0A662);
+  (0x0A664,0x0A664);
+  (0x0A666,0x0A666);
+  (0x0A668,0x0A668);
+  (0x0A66A,0x0A66A);
+  (0x0A66C,0x0A66C);
+  (0x0A680,0x0A680);
+  (0x0A682,0x0A682);
+  (0x0A684,0x0A684);
+  (0x0A686,0x0A686);
+  (0x0A688,0x0A688);
+  (0x0A68A,0x0A68A);
+  (0x0A68C,0x0A68C);
+  (0x0A68E,0x0A68E);
+  (0x0A690,0x0A690);
+  (0x0A692,0x0A692);
+  (0x0A694,0x0A694);
+  (0x0A696,0x0A696);
+  (0x0A698,0x0A698);
+  (0x0A69A,0x0A69A);
+  (0x0A722,0x0A722);
+  (0x0A724,0x0A724);
+  (0x0A726,0x0A726);
+  (0x0A728,0x0A728);
+  (0x0A72A,0x0A72A);
+  (0x0A72C,0x0A72C);
+  (0x0A72E,0x0A72E);
+  (0x0A732,0x0A732);
+  (0x0A734,0x0A734);
+  (0x0A736,0x0A736);
+  (0x0A738,0x0A738);
+  (0x0A73A,0x0A73A);
+  (0x0A73C,0x0A73C);
+  (0x0A73E,0x0A73E);
+  (0x0A740,0x0A740);
+  (0x0A742,0x0A742);
+  (0x0A744,0x0A744);
+  (0x0A746,0x0A746);
+  (0x0A748,0x0A748);
+  (0x0A74A,0x0A74A);
+  (0x0A74C,0x0A74C);
+  (0x0A74E,0x0A74E);
+  (0x0A750,0x0A750);
+  (0x0A752,0x0A752);
+  (0x0A754,0x0A754);
+  (0x0A756,0x0A756);
+  (0x0A758,0x0A758);
+  (0x0A75A,0x0A75A);
+  (0x0A75C,0x0A75C);
+  (0x0A75E,0x0A75E);
+  (0x0A760,0x0A760);
+  (0x0A762,0x0A762);
+  (0x0A764,0x0A764);
+  (0x0A766,0x0A766);
+  (0x0A768,0x0A768);
+  (0x0A76A,0x0A76A);
+  (0x0A76C,0x0A76C);
+  (0x0A76E,0x0A76E);
+  (0x0A779,0x0A779);
+  (0x0A77B,0x0A77B);
+  (0x0A77D,0x0A77E);
+  (0x0A780,0x0A780);
+  (0x0A782,0x0A782);
+  (0x0A784,0x0A784);
+  (0x0A786,0x0A786);
+  (0x0A78B,0x0A78B);
+  (0x0A78D,0x0A78D);
+  (0x0A790,0x0A790);
+  (0x0A792,0x0A792);
+  (0x0A796,0x0A796);
+  (0x0A798,0x0A798);
+  (0x0A79A,0x0A79A);
+  (0x0A79C,0x0A79C);
+  (0x0A79E,0x0A79E);
+  (0x0A7A0,0x0A7A0);
+  (0x0A7A2,0x0A7A2);
+  (0x0A7A4,0x0A7A4);
+  (0x0A7A6,0x0A7A6);
+  (0x0A7A8,0x0A7A8);
+  (0x0A7AA,0x0A7AE);
+  (0x0A7B0,0x0A7B4);
+  (0x0A7B6,0x0A7B6);
   (0x0FF21,0x0FF3A);
-  (0x10400,0x10425);
+  (0x10400,0x10427);
+  (0x104B0,0x104D3);
+  (0x10C80,0x10CB2);
+  (0x118A0,0x118BF);
   (0x1D400,0x1D419);
   (0x1D434,0x1D44D);
   (0x1D468,0x1D481);
@@ -421,14 +626,13 @@ let lu = [
   (0x1D6E2,0x1D6FA);
   (0x1D71C,0x1D734);
   (0x1D756,0x1D76E);
-  (0x1D790,0x1D7A8)
+  (0x1D790,0x1D7A8);
+  (0x1D7CA,0x1D7CA)
 ]
 (* Letter, Lowercase *)
 let ll = [
   (0x00061,0x0007A);
-  (0x000AA,0x000AA);
   (0x000B5,0x000B5);
-  (0x000BA,0x000BA);
   (0x000DF,0x000F6);
   (0x000F8,0x000FF);
   (0x00101,0x00101);
@@ -554,6 +758,7 @@ let ll = [
   (0x0021B,0x0021B);
   (0x0021D,0x0021D);
   (0x0021F,0x0021F);
+  (0x00221,0x00221);
   (0x00223,0x00223);
   (0x00225,0x00225);
   (0x00227,0x00227);
@@ -562,8 +767,20 @@ let ll = [
   (0x0022D,0x0022D);
   (0x0022F,0x0022F);
   (0x00231,0x00231);
-  (0x00233,0x00233);
-  (0x00250,0x002AD);
+  (0x00233,0x00239);
+  (0x0023C,0x0023C);
+  (0x0023F,0x00240);
+  (0x00242,0x00242);
+  (0x00247,0x00247);
+  (0x00249,0x00249);
+  (0x0024B,0x0024B);
+  (0x0024D,0x0024D);
+  (0x0024F,0x00293);
+  (0x00295,0x002AF);
+  (0x00371,0x00371);
+  (0x00373,0x00373);
+  (0x00377,0x00377);
+  (0x0037B,0x0037D);
   (0x00390,0x00390);
   (0x003AC,0x003CE);
   (0x003D0,0x003D1);
@@ -581,6 +798,8 @@ let ll = [
   (0x003ED,0x003ED);
   (0x003EF,0x003F3);
   (0x003F5,0x003F5);
+  (0x003F8,0x003F8);
+  (0x003FB,0x003FC);
   (0x00430,0x0045F);
   (0x00461,0x00461);
   (0x00463,0x00463);
@@ -632,7 +851,7 @@ let ll = [
   (0x004C8,0x004C8);
   (0x004CA,0x004CA);
   (0x004CC,0x004CC);
-  (0x004CE,0x004CE);
+  (0x004CE,0x004CF);
   (0x004D1,0x004D1);
   (0x004D3,0x004D3);
   (0x004D5,0x004D5);
@@ -652,7 +871,11 @@ let ll = [
   (0x004F1,0x004F1);
   (0x004F3,0x004F3);
   (0x004F5,0x004F5);
+  (0x004F7,0x004F7);
   (0x004F9,0x004F9);
+  (0x004FB,0x004FB);
+  (0x004FD,0x004FD);
+  (0x004FF,0x004FF);
   (0x00501,0x00501);
   (0x00503,0x00503);
   (0x00505,0x00505);
@@ -661,7 +884,28 @@ let ll = [
   (0x0050B,0x0050B);
   (0x0050D,0x0050D);
   (0x0050F,0x0050F);
+  (0x00511,0x00511);
+  (0x00513,0x00513);
+  (0x00515,0x00515);
+  (0x00517,0x00517);
+  (0x00519,0x00519);
+  (0x0051B,0x0051B);
+  (0x0051D,0x0051D);
+  (0x0051F,0x0051F);
+  (0x00521,0x00521);
+  (0x00523,0x00523);
+  (0x00525,0x00525);
+  (0x00527,0x00527);
+  (0x00529,0x00529);
+  (0x0052B,0x0052B);
+  (0x0052D,0x0052D);
+  (0x0052F,0x0052F);
   (0x00561,0x00587);
+  (0x013F8,0x013FD);
+  (0x01C80,0x01C88);
+  (0x01D00,0x01D2B);
+  (0x01D6B,0x01D77);
+  (0x01D79,0x01D9A);
   (0x01E01,0x01E01);
   (0x01E03,0x01E03);
   (0x01E05,0x01E05);
@@ -736,7 +980,8 @@ let ll = [
   (0x01E8F,0x01E8F);
   (0x01E91,0x01E91);
   (0x01E93,0x01E93);
-  (0x01E95,0x01E9B);
+  (0x01E95,0x01E9D);
+  (0x01E9F,0x01E9F);
   (0x01EA1,0x01EA1);
   (0x01EA3,0x01EA3);
   (0x01EA5,0x01EA5);
@@ -782,7 +1027,9 @@ let ll = [
   (0x01EF5,0x01EF5);
   (0x01EF7,0x01EF7);
   (0x01EF9,0x01EF9);
-  (0x01F00,0x01F07);
+  (0x01EFB,0x01EFB);
+  (0x01EFD,0x01EFD);
+  (0x01EFF,0x01F07);
   (0x01F10,0x01F15);
   (0x01F20,0x01F27);
   (0x01F30,0x01F37);
@@ -803,28 +1050,198 @@ let ll = [
   (0x01FE0,0x01FE7);
   (0x01FF2,0x01FF4);
   (0x01FF6,0x01FF7);
-  (0x02071,0x02071);
-  (0x0207F,0x0207F);
   (0x0210A,0x0210A);
   (0x0210E,0x0210F);
   (0x02113,0x02113);
   (0x0212F,0x0212F);
   (0x02134,0x02134);
   (0x02139,0x02139);
-  (0x0213D,0x0213D);
+  (0x0213C,0x0213D);
   (0x02146,0x02149);
+  (0x0214E,0x0214E);
+  (0x02184,0x02184);
+  (0x02C30,0x02C5E);
+  (0x02C61,0x02C61);
+  (0x02C65,0x02C66);
+  (0x02C68,0x02C68);
+  (0x02C6A,0x02C6A);
+  (0x02C6C,0x02C6C);
+  (0x02C71,0x02C71);
+  (0x02C73,0x02C74);
+  (0x02C76,0x02C7B);
+  (0x02C81,0x02C81);
+  (0x02C83,0x02C83);
+  (0x02C85,0x02C85);
+  (0x02C87,0x02C87);
+  (0x02C89,0x02C89);
+  (0x02C8B,0x02C8B);
+  (0x02C8D,0x02C8D);
+  (0x02C8F,0x02C8F);
+  (0x02C91,0x02C91);
+  (0x02C93,0x02C93);
+  (0x02C95,0x02C95);
+  (0x02C97,0x02C97);
+  (0x02C99,0x02C99);
+  (0x02C9B,0x02C9B);
+  (0x02C9D,0x02C9D);
+  (0x02C9F,0x02C9F);
+  (0x02CA1,0x02CA1);
+  (0x02CA3,0x02CA3);
+  (0x02CA5,0x02CA5);
+  (0x02CA7,0x02CA7);
+  (0x02CA9,0x02CA9);
+  (0x02CAB,0x02CAB);
+  (0x02CAD,0x02CAD);
+  (0x02CAF,0x02CAF);
+  (0x02CB1,0x02CB1);
+  (0x02CB3,0x02CB3);
+  (0x02CB5,0x02CB5);
+  (0x02CB7,0x02CB7);
+  (0x02CB9,0x02CB9);
+  (0x02CBB,0x02CBB);
+  (0x02CBD,0x02CBD);
+  (0x02CBF,0x02CBF);
+  (0x02CC1,0x02CC1);
+  (0x02CC3,0x02CC3);
+  (0x02CC5,0x02CC5);
+  (0x02CC7,0x02CC7);
+  (0x02CC9,0x02CC9);
+  (0x02CCB,0x02CCB);
+  (0x02CCD,0x02CCD);
+  (0x02CCF,0x02CCF);
+  (0x02CD1,0x02CD1);
+  (0x02CD3,0x02CD3);
+  (0x02CD5,0x02CD5);
+  (0x02CD7,0x02CD7);
+  (0x02CD9,0x02CD9);
+  (0x02CDB,0x02CDB);
+  (0x02CDD,0x02CDD);
+  (0x02CDF,0x02CDF);
+  (0x02CE1,0x02CE1);
+  (0x02CE3,0x02CE4);
+  (0x02CEC,0x02CEC);
+  (0x02CEE,0x02CEE);
+  (0x02CF3,0x02CF3);
+  (0x02D00,0x02D25);
+  (0x02D27,0x02D27);
+  (0x02D2D,0x02D2D);
+  (0x0A641,0x0A641);
+  (0x0A643,0x0A643);
+  (0x0A645,0x0A645);
+  (0x0A647,0x0A647);
+  (0x0A649,0x0A649);
+  (0x0A64B,0x0A64B);
+  (0x0A64D,0x0A64D);
+  (0x0A64F,0x0A64F);
+  (0x0A651,0x0A651);
+  (0x0A653,0x0A653);
+  (0x0A655,0x0A655);
+  (0x0A657,0x0A657);
+  (0x0A659,0x0A659);
+  (0x0A65B,0x0A65B);
+  (0x0A65D,0x0A65D);
+  (0x0A65F,0x0A65F);
+  (0x0A661,0x0A661);
+  (0x0A663,0x0A663);
+  (0x0A665,0x0A665);
+  (0x0A667,0x0A667);
+  (0x0A669,0x0A669);
+  (0x0A66B,0x0A66B);
+  (0x0A66D,0x0A66D);
+  (0x0A681,0x0A681);
+  (0x0A683,0x0A683);
+  (0x0A685,0x0A685);
+  (0x0A687,0x0A687);
+  (0x0A689,0x0A689);
+  (0x0A68B,0x0A68B);
+  (0x0A68D,0x0A68D);
+  (0x0A68F,0x0A68F);
+  (0x0A691,0x0A691);
+  (0x0A693,0x0A693);
+  (0x0A695,0x0A695);
+  (0x0A697,0x0A697);
+  (0x0A699,0x0A699);
+  (0x0A69B,0x0A69B);
+  (0x0A723,0x0A723);
+  (0x0A725,0x0A725);
+  (0x0A727,0x0A727);
+  (0x0A729,0x0A729);
+  (0x0A72B,0x0A72B);
+  (0x0A72D,0x0A72D);
+  (0x0A72F,0x0A731);
+  (0x0A733,0x0A733);
+  (0x0A735,0x0A735);
+  (0x0A737,0x0A737);
+  (0x0A739,0x0A739);
+  (0x0A73B,0x0A73B);
+  (0x0A73D,0x0A73D);
+  (0x0A73F,0x0A73F);
+  (0x0A741,0x0A741);
+  (0x0A743,0x0A743);
+  (0x0A745,0x0A745);
+  (0x0A747,0x0A747);
+  (0x0A749,0x0A749);
+  (0x0A74B,0x0A74B);
+  (0x0A74D,0x0A74D);
+  (0x0A74F,0x0A74F);
+  (0x0A751,0x0A751);
+  (0x0A753,0x0A753);
+  (0x0A755,0x0A755);
+  (0x0A757,0x0A757);
+  (0x0A759,0x0A759);
+  (0x0A75B,0x0A75B);
+  (0x0A75D,0x0A75D);
+  (0x0A75F,0x0A75F);
+  (0x0A761,0x0A761);
+  (0x0A763,0x0A763);
+  (0x0A765,0x0A765);
+  (0x0A767,0x0A767);
+  (0x0A769,0x0A769);
+  (0x0A76B,0x0A76B);
+  (0x0A76D,0x0A76D);
+  (0x0A76F,0x0A76F);
+  (0x0A771,0x0A778);
+  (0x0A77A,0x0A77A);
+  (0x0A77C,0x0A77C);
+  (0x0A77F,0x0A77F);
+  (0x0A781,0x0A781);
+  (0x0A783,0x0A783);
+  (0x0A785,0x0A785);
+  (0x0A787,0x0A787);
+  (0x0A78C,0x0A78C);
+  (0x0A78E,0x0A78E);
+  (0x0A791,0x0A791);
+  (0x0A793,0x0A795);
+  (0x0A797,0x0A797);
+  (0x0A799,0x0A799);
+  (0x0A79B,0x0A79B);
+  (0x0A79D,0x0A79D);
+  (0x0A79F,0x0A79F);
+  (0x0A7A1,0x0A7A1);
+  (0x0A7A3,0x0A7A3);
+  (0x0A7A5,0x0A7A5);
+  (0x0A7A7,0x0A7A7);
+  (0x0A7A9,0x0A7A9);
+  (0x0A7B5,0x0A7B5);
+  (0x0A7B7,0x0A7B7);
+  (0x0A7FA,0x0A7FA);
+  (0x0AB30,0x0AB5A);
+  (0x0AB60,0x0AB65);
+  (0x0AB70,0x0ABBF);
   (0x0FB00,0x0FB06);
   (0x0FB13,0x0FB17);
   (0x0FF41,0x0FF5A);
-  (0x10428,0x1044D);
+  (0x10428,0x1044F);
+  (0x104D8,0x104FB);
+  (0x10CC0,0x10CF2);
+  (0x118C0,0x118DF);
   (0x1D41A,0x1D433);
   (0x1D44E,0x1D454);
   (0x1D456,0x1D467);
   (0x1D482,0x1D49B);
   (0x1D4B6,0x1D4B9);
   (0x1D4BB,0x1D4BB);
-  (0x1D4BD,0x1D4C0);
-  (0x1D4C2,0x1D4C3);
+  (0x1D4BD,0x1D4C3);
   (0x1D4C5,0x1D4CF);
   (0x1D4EA,0x1D503);
   (0x1D51E,0x1D537);
@@ -834,7 +1251,7 @@ let ll = [
   (0x1D5EE,0x1D607);
   (0x1D622,0x1D63B);
   (0x1D656,0x1D66F);
-  (0x1D68A,0x1D6A3);
+  (0x1D68A,0x1D6A5);
   (0x1D6C2,0x1D6DA);
   (0x1D6DC,0x1D6E1);
   (0x1D6FC,0x1D714);
@@ -844,7 +1261,8 @@ let ll = [
   (0x1D770,0x1D788);
   (0x1D78A,0x1D78F);
   (0x1D7AA,0x1D7C2);
-  (0x1D7C4,0x1D7C9)
+  (0x1D7C4,0x1D7C9);
+  (0x1D7CB,0x1D7CB)
 ]
 (* Letter, Titlecase *)
 let lt = [
@@ -856,21 +1274,19 @@ let lt = [
   (0x01F98,0x01F9F);
   (0x01FA8,0x01FAF);
   (0x01FBC,0x01FBC);
-  (0x01FCC,0x01FCC);
-  (0x01FFC,0x01FFC)
+  (0x01FCC,0x01FCC)
 ]
 (* Mark, Non-Spacing *)
 let mn = [
-  (0x00300,0x0034F);
-  (0x00360,0x0036F);
-  (0x00483,0x00486);
-  (0x00591,0x005A1);
-  (0x005A3,0x005B9);
-  (0x005BB,0x005BD);
+  (0x00300,0x0036F);
+  (0x00483,0x00487);
+  (0x00591,0x005BD);
   (0x005BF,0x005BF);
   (0x005C1,0x005C2);
-  (0x005C4,0x005C4);
-  (0x0064B,0x00655);
+  (0x005C4,0x005C5);
+  (0x005C7,0x005C7);
+  (0x00610,0x0061A);
+  (0x0064B,0x0065F);
   (0x00670,0x00670);
   (0x006D6,0x006DC);
   (0x006DF,0x006E4);
@@ -879,46 +1295,65 @@ let mn = [
   (0x00711,0x00711);
   (0x00730,0x0074A);
   (0x007A6,0x007B0);
-  (0x00901,0x00902);
+  (0x007EB,0x007F3);
+  (0x00816,0x00819);
+  (0x0081B,0x00823);
+  (0x00825,0x00827);
+  (0x00829,0x0082D);
+  (0x00859,0x0085B);
+  (0x008D4,0x008E1);
+  (0x008E3,0x00902);
+  (0x0093A,0x0093A);
   (0x0093C,0x0093C);
   (0x00941,0x00948);
   (0x0094D,0x0094D);
-  (0x00951,0x00954);
+  (0x00951,0x00957);
   (0x00962,0x00963);
   (0x00981,0x00981);
   (0x009BC,0x009BC);
   (0x009C1,0x009C4);
   (0x009CD,0x009CD);
   (0x009E2,0x009E3);
-  (0x00A02,0x00A02);
+  (0x00A01,0x00A02);
   (0x00A3C,0x00A3C);
   (0x00A41,0x00A42);
   (0x00A47,0x00A48);
   (0x00A4B,0x00A4D);
+  (0x00A51,0x00A51);
   (0x00A70,0x00A71);
+  (0x00A75,0x00A75);
   (0x00A81,0x00A82);
   (0x00ABC,0x00ABC);
   (0x00AC1,0x00AC5);
   (0x00AC7,0x00AC8);
   (0x00ACD,0x00ACD);
+  (0x00AE2,0x00AE3);
   (0x00B01,0x00B01);
   (0x00B3C,0x00B3C);
   (0x00B3F,0x00B3F);
-  (0x00B41,0x00B43);
+  (0x00B41,0x00B44);
   (0x00B4D,0x00B4D);
   (0x00B56,0x00B56);
+  (0x00B62,0x00B63);
   (0x00B82,0x00B82);
   (0x00BC0,0x00BC0);
   (0x00BCD,0x00BCD);
+  (0x00C00,0x00C00);
   (0x00C3E,0x00C40);
   (0x00C46,0x00C48);
   (0x00C4A,0x00C4D);
   (0x00C55,0x00C56);
+  (0x00C62,0x00C63);
+  (0x00C81,0x00C81);
+  (0x00CBC,0x00CBC);
   (0x00CBF,0x00CBF);
   (0x00CC6,0x00CC6);
   (0x00CCC,0x00CCD);
-  (0x00D41,0x00D43);
+  (0x00CE2,0x00CE3);
+  (0x00D01,0x00D01);
+  (0x00D41,0x00D44);
   (0x00D4D,0x00D4D);
+  (0x00D62,0x00D63);
   (0x00DCA,0x00DCA);
   (0x00DD2,0x00DD4);
   (0x00DD6,0x00DD6);
@@ -936,46 +1371,211 @@ let mn = [
   (0x00F71,0x00F7E);
   (0x00F80,0x00F84);
   (0x00F86,0x00F87);
-  (0x00F90,0x00F97);
+  (0x00F8D,0x00F97);
   (0x00F99,0x00FBC);
   (0x00FC6,0x00FC6);
   (0x0102D,0x01030);
-  (0x01032,0x01032);
-  (0x01036,0x01037);
-  (0x01039,0x01039);
+  (0x01032,0x01037);
+  (0x01039,0x0103A);
+  (0x0103D,0x0103E);
   (0x01058,0x01059);
+  (0x0105E,0x01060);
+  (0x01071,0x01074);
+  (0x01082,0x01082);
+  (0x01085,0x01086);
+  (0x0108D,0x0108D);
+  (0x0109D,0x0109D);
+  (0x0135D,0x0135F);
   (0x01712,0x01714);
   (0x01732,0x01734);
   (0x01752,0x01753);
   (0x01772,0x01773);
+  (0x017B4,0x017B5);
   (0x017B7,0x017BD);
   (0x017C6,0x017C6);
   (0x017C9,0x017D3);
+  (0x017DD,0x017DD);
   (0x0180B,0x0180D);
+  (0x01885,0x01886);
   (0x018A9,0x018A9);
+  (0x01920,0x01922);
+  (0x01927,0x01928);
+  (0x01932,0x01932);
+  (0x01939,0x0193B);
+  (0x01A17,0x01A18);
+  (0x01A1B,0x01A1B);
+  (0x01A56,0x01A56);
+  (0x01A58,0x01A5E);
+  (0x01A60,0x01A60);
+  (0x01A62,0x01A62);
+  (0x01A65,0x01A6C);
+  (0x01A73,0x01A7C);
+  (0x01A7F,0x01A7F);
+  (0x01AB0,0x01ABD);
+  (0x01B00,0x01B03);
+  (0x01B34,0x01B34);
+  (0x01B36,0x01B3A);
+  (0x01B3C,0x01B3C);
+  (0x01B42,0x01B42);
+  (0x01B6B,0x01B73);
+  (0x01B80,0x01B81);
+  (0x01BA2,0x01BA5);
+  (0x01BA8,0x01BA9);
+  (0x01BAB,0x01BAD);
+  (0x01BE6,0x01BE6);
+  (0x01BE8,0x01BE9);
+  (0x01BED,0x01BED);
+  (0x01BEF,0x01BF1);
+  (0x01C2C,0x01C33);
+  (0x01C36,0x01C37);
+  (0x01CD0,0x01CD2);
+  (0x01CD4,0x01CE0);
+  (0x01CE2,0x01CE8);
+  (0x01CED,0x01CED);
+  (0x01CF4,0x01CF4);
+  (0x01CF8,0x01CF9);
+  (0x01DC0,0x01DF5);
+  (0x01DFB,0x01DFF);
   (0x020D0,0x020DC);
   (0x020E1,0x020E1);
-  (0x020E5,0x020EA);
-  (0x0302A,0x0302F);
+  (0x020E5,0x020F0);
+  (0x02CEF,0x02CF1);
+  (0x02D7F,0x02D7F);
+  (0x02DE0,0x02DFF);
+  (0x0302A,0x0302D);
   (0x03099,0x0309A);
+  (0x0A66F,0x0A66F);
+  (0x0A674,0x0A67D);
+  (0x0A69E,0x0A69F);
+  (0x0A6F0,0x0A6F1);
+  (0x0A802,0x0A802);
+  (0x0A806,0x0A806);
+  (0x0A80B,0x0A80B);
+  (0x0A825,0x0A826);
+  (0x0A8C4,0x0A8C5);
+  (0x0A8E0,0x0A8F1);
+  (0x0A926,0x0A92D);
+  (0x0A947,0x0A951);
+  (0x0A980,0x0A982);
+  (0x0A9B3,0x0A9B3);
+  (0x0A9B6,0x0A9B9);
+  (0x0A9BC,0x0A9BC);
+  (0x0A9E5,0x0A9E5);
+  (0x0AA29,0x0AA2E);
+  (0x0AA31,0x0AA32);
+  (0x0AA35,0x0AA36);
+  (0x0AA43,0x0AA43);
+  (0x0AA4C,0x0AA4C);
+  (0x0AA7C,0x0AA7C);
+  (0x0AAB0,0x0AAB0);
+  (0x0AAB2,0x0AAB4);
+  (0x0AAB7,0x0AAB8);
+  (0x0AABE,0x0AABF);
+  (0x0AAC1,0x0AAC1);
+  (0x0AAEC,0x0AAED);
+  (0x0AAF6,0x0AAF6);
+  (0x0ABE5,0x0ABE5);
+  (0x0ABE8,0x0ABE8);
+  (0x0ABED,0x0ABED);
   (0x0FB1E,0x0FB1E);
   (0x0FE00,0x0FE0F);
-  (0x0FE20,0x0FE23);
+  (0x0FE20,0x0FE2F);
+  (0x101FD,0x101FD);
+  (0x102E0,0x102E0);
+  (0x10376,0x1037A);
+  (0x10A01,0x10A03);
+  (0x10A05,0x10A06);
+  (0x10A0C,0x10A0F);
+  (0x10A38,0x10A3A);
+  (0x10A3F,0x10A3F);
+  (0x10AE5,0x10AE6);
+  (0x11001,0x11001);
+  (0x11038,0x11046);
+  (0x1107F,0x11081);
+  (0x110B3,0x110B6);
+  (0x110B9,0x110BA);
+  (0x11100,0x11102);
+  (0x11127,0x1112B);
+  (0x1112D,0x11134);
+  (0x11173,0x11173);
+  (0x11180,0x11181);
+  (0x111B6,0x111BE);
+  (0x111CA,0x111CC);
+  (0x1122F,0x11231);
+  (0x11234,0x11234);
+  (0x11236,0x11237);
+  (0x1123E,0x1123E);
+  (0x112DF,0x112DF);
+  (0x112E3,0x112EA);
+  (0x11300,0x11301);
+  (0x1133C,0x1133C);
+  (0x11340,0x11340);
+  (0x11366,0x1136C);
+  (0x11370,0x11374);
+  (0x11438,0x1143F);
+  (0x11442,0x11444);
+  (0x11446,0x11446);
+  (0x114B3,0x114B8);
+  (0x114BA,0x114BA);
+  (0x114BF,0x114C0);
+  (0x114C2,0x114C3);
+  (0x115B2,0x115B5);
+  (0x115BC,0x115BD);
+  (0x115BF,0x115C0);
+  (0x115DC,0x115DD);
+  (0x11633,0x1163A);
+  (0x1163D,0x1163D);
+  (0x1163F,0x11640);
+  (0x116AB,0x116AB);
+  (0x116AD,0x116AD);
+  (0x116B0,0x116B5);
+  (0x116B7,0x116B7);
+  (0x1171D,0x1171F);
+  (0x11722,0x11725);
+  (0x11727,0x1172B);
+  (0x11C30,0x11C36);
+  (0x11C38,0x11C3D);
+  (0x11C3F,0x11C3F);
+  (0x11C92,0x11CA7);
+  (0x11CAA,0x11CB0);
+  (0x11CB2,0x11CB3);
+  (0x11CB5,0x11CB6);
+  (0x16AF0,0x16AF4);
+  (0x16B30,0x16B36);
+  (0x16F8F,0x16F92);
+  (0x1BC9D,0x1BC9E);
   (0x1D167,0x1D169);
   (0x1D17B,0x1D182);
   (0x1D185,0x1D18B);
-  (0x1D1AA,0x1D1AD)
+  (0x1D1AA,0x1D1AD);
+  (0x1D242,0x1D244);
+  (0x1DA00,0x1DA36);
+  (0x1DA3B,0x1DA6C);
+  (0x1DA75,0x1DA75);
+  (0x1DA84,0x1DA84);
+  (0x1DA9B,0x1DA9F);
+  (0x1DAA1,0x1DAAF);
+  (0x1E000,0x1E006);
+  (0x1E008,0x1E018);
+  (0x1E01B,0x1E021);
+  (0x1E023,0x1E024);
+  (0x1E026,0x1E02A);
+  (0x1E8D0,0x1E8D6);
+  (0x1E944,0x1E94A)
 ]
 (* Mark, Spacing Combining *)
 let mc = [
   (0x00903,0x00903);
+  (0x0093B,0x0093B);
   (0x0093E,0x00940);
   (0x00949,0x0094C);
+  (0x0094E,0x0094F);
   (0x00982,0x00983);
   (0x009BE,0x009C0);
   (0x009C7,0x009C8);
   (0x009CB,0x009CC);
   (0x009D7,0x009D7);
+  (0x00A03,0x00A03);
   (0x00A3E,0x00A40);
   (0x00A83,0x00A83);
   (0x00ABE,0x00AC0);
@@ -1011,20 +1611,119 @@ let mc = [
   (0x00DF2,0x00DF3);
   (0x00F3E,0x00F3F);
   (0x00F7F,0x00F7F);
-  (0x0102C,0x0102C);
+  (0x0102B,0x0102C);
   (0x01031,0x01031);
   (0x01038,0x01038);
+  (0x0103B,0x0103C);
   (0x01056,0x01057);
-  (0x017B4,0x017B6);
+  (0x01062,0x01064);
+  (0x01067,0x0106D);
+  (0x01083,0x01084);
+  (0x01087,0x0108C);
+  (0x0108F,0x0108F);
+  (0x0109A,0x0109C);
+  (0x017B6,0x017B6);
   (0x017BE,0x017C5);
   (0x017C7,0x017C8);
-  (0x1D165,0x1D166);
-  (0x1D16D,0x1D172)
+  (0x01923,0x01926);
+  (0x01929,0x0192B);
+  (0x01930,0x01931);
+  (0x01933,0x01938);
+  (0x01A19,0x01A1A);
+  (0x01A55,0x01A55);
+  (0x01A57,0x01A57);
+  (0x01A61,0x01A61);
+  (0x01A63,0x01A64);
+  (0x01A6D,0x01A72);
+  (0x01B04,0x01B04);
+  (0x01B35,0x01B35);
+  (0x01B3B,0x01B3B);
+  (0x01B3D,0x01B41);
+  (0x01B43,0x01B44);
+  (0x01B82,0x01B82);
+  (0x01BA1,0x01BA1);
+  (0x01BA6,0x01BA7);
+  (0x01BAA,0x01BAA);
+  (0x01BE7,0x01BE7);
+  (0x01BEA,0x01BEC);
+  (0x01BEE,0x01BEE);
+  (0x01BF2,0x01BF3);
+  (0x01C24,0x01C2B);
+  (0x01C34,0x01C35);
+  (0x01CE1,0x01CE1);
+  (0x01CF2,0x01CF3);
+  (0x0302E,0x0302F);
+  (0x0A823,0x0A824);
+  (0x0A827,0x0A827);
+  (0x0A880,0x0A881);
+  (0x0A8B4,0x0A8C3);
+  (0x0A952,0x0A953);
+  (0x0A983,0x0A983);
+  (0x0A9B4,0x0A9B5);
+  (0x0A9BA,0x0A9BB);
+  (0x0A9BD,0x0A9C0);
+  (0x0AA2F,0x0AA30);
+  (0x0AA33,0x0AA34);
+  (0x0AA4D,0x0AA4D);
+  (0x0AA7B,0x0AA7B);
+  (0x0AA7D,0x0AA7D);
+  (0x0AAEB,0x0AAEB);
+  (0x0AAEE,0x0AAEF);
+  (0x0AAF5,0x0AAF5);
+  (0x0ABE3,0x0ABE4);
+  (0x0ABE6,0x0ABE7);
+  (0x0ABE9,0x0ABEA);
+  (0x0ABEC,0x0ABEC);
+  (0x11000,0x11000);
+  (0x11002,0x11002);
+  (0x11082,0x11082);
+  (0x110B0,0x110B2);
+  (0x110B7,0x110B8);
+  (0x1112C,0x1112C);
+  (0x11182,0x11182);
+  (0x111B3,0x111B5);
+  (0x111BF,0x111C0);
+  (0x1122C,0x1122E);
+  (0x11232,0x11233);
+  (0x11235,0x11235);
+  (0x112E0,0x112E2);
+  (0x11302,0x11303);
+  (0x1133E,0x1133F);
+  (0x11341,0x11344);
+  (0x11347,0x11348);
+  (0x1134B,0x1134D);
+  (0x11357,0x11357);
+  (0x11362,0x11363);
+  (0x11435,0x11437);
+  (0x11440,0x11441);
+  (0x11445,0x11445);
+  (0x114B0,0x114B2);
+  (0x114B9,0x114B9);
+  (0x114BB,0x114BE);
+  (0x114C1,0x114C1);
+  (0x115AF,0x115B1);
+  (0x115B8,0x115BB);
+  (0x115BE,0x115BE);
+  (0x11630,0x11632);
+  (0x1163B,0x1163C);
+  (0x1163E,0x1163E);
+  (0x116AC,0x116AC);
+  (0x116AE,0x116AF);
+  (0x116B6,0x116B6);
+  (0x11720,0x11721);
+  (0x11726,0x11726);
+  (0x11C2F,0x11C2F);
+  (0x11C3E,0x11C3E);
+  (0x11CA9,0x11CA9);
+  (0x11CB1,0x11CB1);
+  (0x11CB4,0x11CB4);
+  (0x16F51,0x16F7E);
+  (0x1D165,0x1D166)
 ]
 (* Mark, Enclosing *)
 let me = [
   (0x00488,0x00489);
-  (0x006DE,0x006DE);
+  (0x01ABE,0x01ABE);
   (0x020DD,0x020E0);
   (0x020E2,0x020E4)
 ]
@@ -1033,33 +1732,70 @@ let nd = [
   (0x00030,0x00039);
   (0x00660,0x00669);
   (0x006F0,0x006F9);
+  (0x007C0,0x007C9);
   (0x00966,0x0096F);
   (0x009E6,0x009EF);
   (0x00A66,0x00A6F);
   (0x00AE6,0x00AEF);
   (0x00B66,0x00B6F);
-  (0x00BE7,0x00BEF);
+  (0x00BE6,0x00BEF);
   (0x00C66,0x00C6F);
   (0x00CE6,0x00CEF);
   (0x00D66,0x00D6F);
+  (0x00DE6,0x00DEF);
   (0x00E50,0x00E59);
   (0x00ED0,0x00ED9);
   (0x00F20,0x00F29);
   (0x01040,0x01049);
-  (0x01369,0x01371);
+  (0x01090,0x01099);
   (0x017E0,0x017E9);
   (0x01810,0x01819);
+  (0x01946,0x0194F);
+  (0x019D0,0x019D9);
+  (0x01A80,0x01A89);
+  (0x01A90,0x01A99);
+  (0x01B50,0x01B59);
+  (0x01BB0,0x01BB9);
+  (0x01C40,0x01C49);
+  (0x01C50,0x01C59);
+  (0x0A620,0x0A629);
+  (0x0A8D0,0x0A8D9);
+  (0x0A900,0x0A909);
+  (0x0A9D0,0x0A9D9);
+  (0x0A9F0,0x0A9F9);
+  (0x0AA50,0x0AA59);
+  (0x0ABF0,0x0ABF9);
   (0x0FF10,0x0FF19);
+  (0x104A0,0x104A9);
+  (0x11066,0x1106F);
+  (0x110F0,0x110F9);
+  (0x11136,0x1113F);
+  (0x111D0,0x111D9);
+  (0x112F0,0x112F9);
+  (0x11450,0x11459);
+  (0x114D0,0x114D9);
+  (0x11650,0x11659);
+  (0x116C0,0x116C9);
+  (0x11730,0x11739);
+  (0x118E0,0x118E9);
+  (0x11C50,0x11C59);
+  (0x16A60,0x16A69);
+  (0x16B50,0x16B59);
   (0x1D7CE,0x1D7FF)
 ]
 (* Number, Letter *)
 let nl = [
   (0x016EE,0x016F0);
-  (0x02160,0x02183);
+  (0x02160,0x02182);
+  (0x02185,0x02188);
   (0x03007,0x03007);
   (0x03021,0x03029);
   (0x03038,0x0303A);
-  (0x1034A,0x1034A)
+  (0x0A6E6,0x0A6EF);
+  (0x10140,0x10174);
+  (0x10341,0x10341);
+  (0x1034A,0x1034A);
+  (0x103D1,0x103D5)
 ]
 (* Number, Other *)
 let no = [
@@ -1067,116 +1803,139 @@ let no = [
   (0x000B9,0x000B9);
   (0x000BC,0x000BE);
   (0x009F4,0x009F9);
+  (0x00B72,0x00B77);
   (0x00BF0,0x00BF2);
+  (0x00C78,0x00C7E);
+  (0x00D58,0x00D5E);
+  (0x00D70,0x00D78);
   (0x00F2A,0x00F33);
-  (0x01372,0x0137C);
+  (0x01369,0x0137C);
+  (0x017F0,0x017F9);
+  (0x019DA,0x019DA);
   (0x02070,0x02070);
   (0x02074,0x02079);
   (0x02080,0x02089);
-  (0x02153,0x0215F);
+  (0x02150,0x0215F);
+  (0x02189,0x02189);
   (0x02460,0x0249B);
-  (0x024EA,0x024FE);
+  (0x024EA,0x024FF);
   (0x02776,0x02793);
+  (0x02CFD,0x02CFD);
   (0x03192,0x03195);
   (0x03220,0x03229);
+  (0x03248,0x0324F);
   (0x03251,0x0325F);
   (0x03280,0x03289);
   (0x032B1,0x032BF);
-  (0x10320,0x10323)
+  (0x0A830,0x0A835);
+  (0x10107,0x10133);
+  (0x10175,0x10178);
+  (0x1018A,0x1018B);
+  (0x102E1,0x102FB);
+  (0x10320,0x10323);
+  (0x10858,0x1085F);
+  (0x10879,0x1087F);
+  (0x108A7,0x108AF);
+  (0x108FB,0x108FF);
+  (0x10916,0x1091B);
+  (0x109BC,0x109BD);
+  (0x109C0,0x109CF);
+  (0x109D2,0x109FF);
+  (0x10A40,0x10A47);
+  (0x10A7D,0x10A7E);
+  (0x10A9D,0x10A9F);
+  (0x10AEB,0x10AEF);
+  (0x10B58,0x10B5F);
+  (0x10B78,0x10B7F);
+  (0x10BA9,0x10BAF);
+  (0x10CFA,0x10CFF);
+  (0x10E60,0x10E7E);
+  (0x11052,0x11065);
+  (0x111E1,0x111F4);
+  (0x1173A,0x1173B);
+  (0x118EA,0x118F2);
+  (0x11C5A,0x11C6C);
+  (0x16B5B,0x16B61);
+  (0x1D360,0x1D371);
+  (0x1E8C7,0x1E8CF)
 ]
 (* Separator, Space *)
 let zs = [
   (0x00020,0x00020);
   (0x000A0,0x000A0);
   (0x01680,0x01680);
-  (0x02000,0x0200B);
+  (0x02000,0x0200A);
   (0x0202F,0x0202F);
-  (0x0205F,0x0205F);
-  (0x03000,0x03000)
+  (0x0205F,0x0205F)
 ]
 (* Separator, Line *)
 let zl = [
-  (0x02028,0x02028)
+
 ]
 (* Separator, Paragraph *)
 let zp = [
-  (0x02029,0x02029)
+
 ]
 (* Other, Control *)
 let cc = [
-  (0x00000,0x0001F);
-  (0x0007F,0x0009F)
+  (0x00000,0x0001F)
 ]
 (* Other, Format *)
 let cf = [
+  (0x000AD,0x000AD);
+  (0x00600,0x00605);
+  (0x0061C,0x0061C);
   (0x006DD,0x006DD);
   (0x0070F,0x0070F);
+  (0x008E2,0x008E2);
   (0x0180E,0x0180E);
-  (0x0200C,0x0200F);
+  (0x0200B,0x0200F);
   (0x0202A,0x0202E);
-  (0x02060,0x02063);
-  (0x0206A,0x0206F);
+  (0x02060,0x02064);
+  (0x02066,0x0206F);
   (0x0FEFF,0x0FEFF);
   (0x0FFF9,0x0FFFB);
+  (0x110BD,0x110BD);
+  (0x1BCA0,0x1BCA3);
   (0x1D173,0x1D17A);
-  (0xE0001,0xE0001);
-  (0xE0020,0xE007F)
+  (0xE0001,0xE0001)
 ]
 (* Other, Surrogate *)
 let cs = [
-  (0x0D800,0x0DEFE);
-  (0x0DFFF,0x0DFFF)
+
 ]
 (* Other, Private Use *)
 let co = [
-  (0x0E000,0x0F8FF)
+  (0x0E000,0x0F8FF);
+  (0xF0000,0xFFFFD)
 ]
 (* Other, Not Assigned *)
 let cn = [
-  (0x00221,0x00221);
-  (0x00234,0x0024F);
-  (0x002AE,0x002AF);
-  (0x002EF,0x002FF);
-  (0x00350,0x0035F);
-  (0x00370,0x00373);
-  (0x00376,0x00379);
-  (0x0037B,0x0037D);
-  (0x0037F,0x00383);
+  (0x00378,0x00379);
+  (0x00380,0x00383);
   (0x0038B,0x0038B);
   (0x0038D,0x0038D);
   (0x003A2,0x003A2);
-  (0x003CF,0x003CF);
-  (0x003F7,0x003FF);
-  (0x00487,0x00487);
-  (0x004CF,0x004CF);
-  (0x004F6,0x004F7);
-  (0x004FA,0x004FF);
-  (0x00510,0x00530);
+  (0x00530,0x00530);
   (0x00557,0x00558);
   (0x00560,0x00560);
   (0x00588,0x00588);
-  (0x0058B,0x00590);
-  (0x005A2,0x005A2);
-  (0x005BA,0x005BA);
-  (0x005C5,0x005CF);
+  (0x0058B,0x0058C);
+  (0x00590,0x00590);
+  (0x005C8,0x005CF);
   (0x005EB,0x005EF);
-  (0x005F5,0x0060B);
-  (0x0060D,0x0061A);
-  (0x0061C,0x0061E);
-  (0x00620,0x00620);
-  (0x0063B,0x0063F);
-  (0x00656,0x0065F);
-  (0x006EE,0x006EF);
-  (0x006FF,0x006FF);
+  (0x005F5,0x005FF);
+  (0x0061D,0x0061D);
   (0x0070E,0x0070E);
-  (0x0072D,0x0072F);
-  (0x0074B,0x0077F);
-  (0x007B2,0x00900);
-  (0x00904,0x00904);
-  (0x0093A,0x0093B);
-  (0x0094E,0x0094F);
-  (0x00955,0x00957);
-  (0x00971,0x00980);
+  (0x0074B,0x0074C);
+  (0x007B2,0x007BF);
+  (0x007FB,0x007FF);
+  (0x0082E,0x0082F);
+  (0x0083F,0x0083F);
+  (0x0085C,0x0085D);
+  (0x0085F,0x0089F);
+  (0x008B5,0x008B5);
+  (0x008BE,0x008D3);
   (0x00984,0x00984);
   (0x0098D,0x0098E);
   (0x00991,0x00992);
@@ -1184,15 +1943,14 @@ let cn = [
   (0x009B1,0x009B1);
   (0x009B3,0x009B5);
   (0x009BA,0x009BB);
-  (0x009BD,0x009BD);
   (0x009C5,0x009C6);
   (0x009C9,0x009CA);
-  (0x009CE,0x009D6);
+  (0x009CF,0x009D6);
   (0x009D8,0x009DB);
   (0x009DE,0x009DE);
   (0x009E4,0x009E5);
-  (0x009FB,0x00A01);
-  (0x00A03,0x00A04);
+  (0x009FC,0x00A00);
+  (0x00A04,0x00A04);
   (0x00A0B,0x00A0E);
   (0x00A11,0x00A12);
   (0x00A29,0x00A29);
@@ -1203,12 +1961,12 @@ let cn = [
   (0x00A3D,0x00A3D);
   (0x00A43,0x00A46);
   (0x00A49,0x00A4A);
-  (0x00A4E,0x00A58);
+  (0x00A4E,0x00A50);
+  (0x00A52,0x00A58);
   (0x00A5D,0x00A5D);
   (0x00A5F,0x00A65);
-  (0x00A75,0x00A80);
+  (0x00A76,0x00A80);
   (0x00A84,0x00A84);
-  (0x00A8C,0x00A8C);
   (0x00A8E,0x00A8E);
   (0x00A92,0x00A92);
   (0x00AA9,0x00AA9);
@@ -1219,22 +1977,23 @@ let cn = [
   (0x00ACA,0x00ACA);
   (0x00ACE,0x00ACF);
   (0x00AD1,0x00ADF);
-  (0x00AE1,0x00AE5);
-  (0x00AF0,0x00B00);
+  (0x00AE4,0x00AE5);
+  (0x00AF2,0x00AF8);
+  (0x00AFA,0x00B00);
   (0x00B04,0x00B04);
   (0x00B0D,0x00B0E);
   (0x00B11,0x00B12);
   (0x00B29,0x00B29);
   (0x00B31,0x00B31);
-  (0x00B34,0x00B35);
+  (0x00B34,0x00B34);
   (0x00B3A,0x00B3B);
-  (0x00B44,0x00B46);
+  (0x00B45,0x00B46);
   (0x00B49,0x00B4A);
   (0x00B4E,0x00B55);
   (0x00B58,0x00B5B);
   (0x00B5E,0x00B5E);
-  (0x00B62,0x00B65);
-  (0x00B71,0x00B81);
+  (0x00B64,0x00B65);
+  (0x00B78,0x00B81);
   (0x00B84,0x00B84);
   (0x00B8B,0x00B8D);
   (0x00B91,0x00B91);
@@ -1244,49 +2003,48 @@ let cn = [
   (0x00BA0,0x00BA2);
   (0x00BA5,0x00BA7);
   (0x00BAB,0x00BAD);
-  (0x00BB6,0x00BB6);
   (0x00BBA,0x00BBD);
   (0x00BC3,0x00BC5);
   (0x00BC9,0x00BC9);
-  (0x00BCE,0x00BD6);
-  (0x00BD8,0x00BE6);
-  (0x00BF3,0x00C00);
+  (0x00BCE,0x00BCF);
+  (0x00BD1,0x00BD6);
+  (0x00BD8,0x00BE5);
+  (0x00BFB,0x00BFF);
   (0x00C04,0x00C04);
   (0x00C0D,0x00C0D);
   (0x00C11,0x00C11);
   (0x00C29,0x00C29);
-  (0x00C34,0x00C34);
-  (0x00C3A,0x00C3D);
+  (0x00C3A,0x00C3C);
   (0x00C45,0x00C45);
   (0x00C49,0x00C49);
   (0x00C4E,0x00C54);
-  (0x00C57,0x00C5F);
-  (0x00C62,0x00C65);
-  (0x00C70,0x00C81);
+  (0x00C57,0x00C57);
+  (0x00C5B,0x00C5F);
+  (0x00C64,0x00C65);
+  (0x00C70,0x00C77);
   (0x00C84,0x00C84);
   (0x00C8D,0x00C8D);
   (0x00C91,0x00C91);
   (0x00CA9,0x00CA9);
   (0x00CB4,0x00CB4);
-  (0x00CBA,0x00CBD);
+  (0x00CBA,0x00CBB);
   (0x00CC5,0x00CC5);
   (0x00CC9,0x00CC9);
   (0x00CCE,0x00CD4);
   (0x00CD7,0x00CDD);
   (0x00CDF,0x00CDF);
-  (0x00CE2,0x00CE5);
-  (0x00CF0,0x00D01);
+  (0x00CE4,0x00CE5);
+  (0x00CF0,0x00CF0);
+  (0x00CF3,0x00D00);
   (0x00D04,0x00D04);
   (0x00D0D,0x00D0D);
   (0x00D11,0x00D11);
-  (0x00D29,0x00D29);
-  (0x00D3A,0x00D3D);
-  (0x00D44,0x00D45);
+  (0x00D3B,0x00D3C);
+  (0x00D45,0x00D45);
   (0x00D49,0x00D49);
-  (0x00D4E,0x00D56);
-  (0x00D58,0x00D5F);
-  (0x00D62,0x00D65);
-  (0x00D70,0x00D81);
+  (0x00D50,0x00D53);
+  (0x00D64,0x00D65);
+  (0x00D80,0x00D81);
   (0x00D84,0x00D84);
   (0x00D97,0x00D99);
   (0x00DB2,0x00DB2);
@@ -1296,7 +2054,8 @@ let cn = [
   (0x00DCB,0x00DCE);
   (0x00DD5,0x00DD5);
   (0x00DD7,0x00DD7);
-  (0x00DE0,0x00DF1);
+  (0x00DE0,0x00DE5);
+  (0x00DF0,0x00DF1);
   (0x00DF5,0x00E00);
   (0x00E3B,0x00E3E);
   (0x00E5C,0x00E80);
@@ -1317,56 +2076,38 @@ let cn = [
   (0x00EC7,0x00EC7);
   (0x00ECE,0x00ECF);
   (0x00EDA,0x00EDB);
-  (0x00EDE,0x00EFF);
+  (0x00EE0,0x00EFF);
   (0x00F48,0x00F48);
-  (0x00F6B,0x00F70);
-  (0x00F8C,0x00F8F);
+  (0x00F6D,0x00F70);
   (0x00F98,0x00F98);
   (0x00FBD,0x00FBD);
-  (0x00FCD,0x00FCE);
-  (0x00FD0,0x00FFF);
-  (0x01022,0x01022);
-  (0x01028,0x01028);
-  (0x0102B,0x0102B);
-  (0x01033,0x01035);
-  (0x0103A,0x0103F);
-  (0x0105A,0x0109F);
-  (0x010C6,0x010CF);
-  (0x010F9,0x010FA);
-  (0x010FC,0x010FF);
-  (0x0115A,0x0115E);
-  (0x011A3,0x011A7);
-  (0x011FA,0x011FF);
-  (0x01207,0x01207);
-  (0x01247,0x01247);
+  (0x00FCD,0x00FCD);
+  (0x00FDB,0x00FFF);
+  (0x010C6,0x010C6);
+  (0x010C8,0x010CC);
+  (0x010CE,0x010CF);
   (0x01249,0x01249);
   (0x0124E,0x0124F);
   (0x01257,0x01257);
   (0x01259,0x01259);
   (0x0125E,0x0125F);
-  (0x01287,0x01287);
   (0x01289,0x01289);
   (0x0128E,0x0128F);
-  (0x012AF,0x012AF);
   (0x012B1,0x012B1);
   (0x012B6,0x012B7);
   (0x012BF,0x012BF);
   (0x012C1,0x012C1);
   (0x012C6,0x012C7);
-  (0x012CF,0x012CF);
   (0x012D7,0x012D7);
-  (0x012EF,0x012EF);
-  (0x0130F,0x0130F);
   (0x01311,0x01311);
   (0x01316,0x01317);
-  (0x0131F,0x0131F);
-  (0x01347,0x01347);
-  (0x0135B,0x01360);
-  (0x0137D,0x0139F);
-  (0x013F5,0x01400);
-  (0x01677,0x0167F);
+  (0x0135B,0x0135C);
+  (0x0137D,0x0137F);
+  (0x0139A,0x0139F);
+  (0x013F6,0x013F7);
+  (0x013FE,0x013FF);
   (0x0169D,0x0169F);
-  (0x016F1,0x016FF);
+  (0x016F9,0x016FF);
   (0x0170D,0x0170D);
   (0x01715,0x0171F);
   (0x01737,0x0173F);
@@ -1374,14 +2115,40 @@ let cn = [
   (0x0176D,0x0176D);
   (0x01771,0x01771);
   (0x01774,0x0177F);
-  (0x017DD,0x017DF);
-  (0x017EA,0x017FF);
+  (0x017DE,0x017DF);
+  (0x017EA,0x017EF);
+  (0x017FA,0x017FF);
   (0x0180F,0x0180F);
   (0x0181A,0x0181F);
   (0x01878,0x0187F);
-  (0x018AA,0x01DFF);
-  (0x01E9C,0x01E9F);
-  (0x01EFA,0x01EFF);
+  (0x018AB,0x018AF);
+  (0x018F6,0x018FF);
+  (0x0191F,0x0191F);
+  (0x0192C,0x0192F);
+  (0x0193C,0x0193F);
+  (0x01941,0x01943);
+  (0x0196E,0x0196F);
+  (0x01975,0x0197F);
+  (0x019AC,0x019AF);
+  (0x019CA,0x019CF);
+  (0x019DB,0x019DD);
+  (0x01A1C,0x01A1D);
+  (0x01A5F,0x01A5F);
+  (0x01A7D,0x01A7E);
+  (0x01A8A,0x01A8F);
+  (0x01A9A,0x01A9F);
+  (0x01AAE,0x01AAF);
+  (0x01ABF,0x01AFF);
+  (0x01B4C,0x01B4F);
+  (0x01B7D,0x01B7F);
+  (0x01BF4,0x01BFB);
+  (0x01C38,0x01C3A);
+  (0x01C4A,0x01C4C);
+  (0x01C89,0x01CBF);
+  (0x01CC8,0x01CCF);
+  (0x01CF7,0x01CF7);
+  (0x01CFA,0x01CFF);
+  (0x01DF6,0x01DFA);
   (0x01F16,0x01F17);
   (0x01F1E,0x01F1F);
   (0x01F46,0x01F47);
@@ -1398,37 +2165,40 @@ let cn = [
   (0x01FF0,0x01FF1);
   (0x01FF5,0x01FF5);
   (0x01FFF,0x01FFF);
-  (0x02053,0x02056);
-  (0x02058,0x0205E);
-  (0x02064,0x02069);
+  (0x02065,0x02065);
   (0x02072,0x02073);
-  (0x0208F,0x0209F);
-  (0x020B2,0x020CF);
-  (0x020EB,0x020FF);
-  (0x0213B,0x0213C);
-  (0x0214C,0x02152);
-  (0x02184,0x0218F);
-  (0x023CF,0x023FF);
+  (0x0208F,0x0208F);
+  (0x0209D,0x0209F);
+  (0x020BF,0x020CF);
+  (0x020F1,0x020FF);
+  (0x0218C,0x0218F);
+  (0x023FF,0x023FF);
   (0x02427,0x0243F);
   (0x0244B,0x0245F);
-  (0x024FF,0x024FF);
-  (0x02614,0x02615);
-  (0x02618,0x02618);
-  (0x0267E,0x0267F);
-  (0x0268A,0x02700);
-  (0x02705,0x02705);
-  (0x0270A,0x0270B);
-  (0x02728,0x02728);
-  (0x0274C,0x0274C);
-  (0x0274E,0x0274E);
-  (0x02753,0x02755);
-  (0x02757,0x02757);
-  (0x0275F,0x02760);
-  (0x02795,0x02797);
-  (0x027B0,0x027B0);
-  (0x027BF,0x027CF);
-  (0x027EC,0x027EF);
-  (0x02B00,0x02E7F);
+  (0x02B74,0x02B75);
+  (0x02B96,0x02B97);
+  (0x02BBA,0x02BBC);
+  (0x02BC9,0x02BC9);
+  (0x02BD2,0x02BEB);
+  (0x02BF0,0x02BFF);
+  (0x02C2F,0x02C2F);
+  (0x02C5F,0x02C5F);
+  (0x02CF4,0x02CF8);
+  (0x02D26,0x02D26);
+  (0x02D28,0x02D2C);
+  (0x02D2E,0x02D2F);
+  (0x02D68,0x02D6E);
+  (0x02D71,0x02D7E);
+  (0x02D97,0x02D9F);
+  (0x02DA7,0x02DA7);
+  (0x02DAF,0x02DAF);
+  (0x02DB7,0x02DB7);
+  (0x02DBF,0x02DBF);
+  (0x02DC7,0x02DC7);
+  (0x02DCF,0x02DCF);
+  (0x02DD7,0x02DD7);
+  (0x02DDF,0x02DDF);
+  (0x02E45,0x02E7F);
   (0x02E9A,0x02E9A);
   (0x02EF4,0x02EFF);
   (0x02FD6,0x02FEF);
@@ -1436,25 +2206,49 @@ let cn = [
   (0x03040,0x03040);
   (0x03097,0x03098);
   (0x03100,0x03104);
-  (0x0312D,0x03130);
+  (0x0312E,0x03130);
   (0x0318F,0x0318F);
-  (0x031B8,0x031EF);
-  (0x0321D,0x0321F);
-  (0x03244,0x03250);
-  (0x0327C,0x0327E);
-  (0x032CC,0x032CF);
+  (0x031BB,0x031BF);
+  (0x031E4,0x031EF);
+  (0x0321F,0x0321F);
   (0x032FF,0x032FF);
-  (0x03377,0x0337A);
-  (0x033DE,0x033DF);
-  (0x033FF,0x033FF);
-  (0x04DB6,0x04DFF);
-  (0x09FA6,0x09FFF);
+  (0x04DB6,0x04DBF);
+  (0x09FD6,0x09FFF);
   (0x0A48D,0x0A48F);
-  (0x0A4C7,0x0ABFF);
-  (0x0D7A4,0x0D7FF);
-  (0x0DEFF,0x0DFFE);
-  (0x0FA2E,0x0FA2F);
-  (0x0FA6B,0x0FAFF);
+  (0x0A4C7,0x0A4CF);
+  (0x0A62C,0x0A63F);
+  (0x0A6F8,0x0A6FF);
+  (0x0A7AF,0x0A7AF);
+  (0x0A7B8,0x0A7F6);
+  (0x0A82C,0x0A82F);
+  (0x0A83A,0x0A83F);
+  (0x0A878,0x0A87F);
+  (0x0A8C6,0x0A8CD);
+  (0x0A8DA,0x0A8DF);
+  (0x0A8FE,0x0A8FF);
+  (0x0A954,0x0A95E);
+  (0x0A97D,0x0A97F);
+  (0x0A9CE,0x0A9CE);
+  (0x0A9DA,0x0A9DD);
+  (0x0A9FF,0x0A9FF);
+  (0x0AA37,0x0AA3F);
+  (0x0AA4E,0x0AA4F);
+  (0x0AA5A,0x0AA5B);
+  (0x0AAC3,0x0AADA);
+  (0x0AAF7,0x0AB00);
+  (0x0AB07,0x0AB08);
+  (0x0AB0F,0x0AB10);
+  (0x0AB17,0x0AB1F);
+  (0x0AB27,0x0AB27);
+  (0x0AB2F,0x0AB2F);
+  (0x0AB66,0x0AB6F);
+  (0x0ABEE,0x0ABEF);
+  (0x0ABFA,0x0ABFF);
+  (0x0D7A4,0x0D7AF);
+  (0x0D7C7,0x0D7CA);
+  (0x0D7FC,0x0D7FF);
+  (0x0FA6E,0x0FA6F);
+  (0x0FADA,0x0FAFF);
   (0x0FB07,0x0FB12);
   (0x0FB18,0x0FB1C);
   (0x0FB37,0x0FB37);
@@ -1462,14 +2256,12 @@ let cn = [
   (0x0FB3F,0x0FB3F);
   (0x0FB42,0x0FB42);
   (0x0FB45,0x0FB45);
-  (0x0FBB2,0x0FBD2);
+  (0x0FBC2,0x0FBD2);
   (0x0FD40,0x0FD4F);
   (0x0FD90,0x0FD91);
   (0x0FDC8,0x0FDEF);
-  (0x0FDFD,0x0FDFF);
-  (0x0FE10,0x0FE1F);
-  (0x0FE24,0x0FE2F);
-  (0x0FE47,0x0FE48);
+  (0x0FDFE,0x0FDFF);
+  (0x0FE1A,0x0FE1F);
   (0x0FE53,0x0FE53);
   (0x0FE67,0x0FE67);
   (0x0FE6C,0x0FE6F);
@@ -1483,15 +2275,171 @@ let cn = [
   (0x0FFDD,0x0FFDF);
   (0x0FFE7,0x0FFE7);
   (0x0FFEF,0x0FFF8);
-  (0x0FFFE,0x102FF);
-  (0x1031F,0x1031F);
+  (0x0FFFE,0x0FFFF);
+  (0x1000C,0x1000C);
+  (0x10027,0x10027);
+  (0x1003B,0x1003B);
+  (0x1003E,0x1003E);
+  (0x1004E,0x1004F);
+  (0x1005E,0x1007F);
+  (0x100FB,0x100FF);
+  (0x10103,0x10106);
+  (0x10134,0x10136);
+  (0x1018F,0x1018F);
+  (0x1019C,0x1019F);
+  (0x101A1,0x101CF);
+  (0x101FE,0x1027F);
+  (0x1029D,0x1029F);
+  (0x102D1,0x102DF);
+  (0x102FC,0x102FF);
   (0x10324,0x1032F);
-  (0x1034B,0x103FF);
-  (0x10426,0x10427);
-  (0x1044E,0x1CFFF);
+  (0x1034B,0x1034F);
+  (0x1037B,0x1037F);
+  (0x1039E,0x1039E);
+  (0x103C4,0x103C7);
+  (0x103D6,0x103FF);
+  (0x1049E,0x1049F);
+  (0x104AA,0x104AF);
+  (0x104D4,0x104D7);
+  (0x104FC,0x104FF);
+  (0x10528,0x1052F);
+  (0x10564,0x1056E);
+  (0x10570,0x105FF);
+  (0x10737,0x1073F);
+  (0x10756,0x1075F);
+  (0x10768,0x107FF);
+  (0x10806,0x10807);
+  (0x10809,0x10809);
+  (0x10836,0x10836);
+  (0x10839,0x1083B);
+  (0x1083D,0x1083E);
+  (0x10856,0x10856);
+  (0x1089F,0x108A6);
+  (0x108B0,0x108DF);
+  (0x108F3,0x108F3);
+  (0x108F6,0x108FA);
+  (0x1091C,0x1091E);
+  (0x1093A,0x1093E);
+  (0x10940,0x1097F);
+  (0x109B8,0x109BB);
+  (0x109D0,0x109D1);
+  (0x10A04,0x10A04);
+  (0x10A07,0x10A0B);
+  (0x10A14,0x10A14);
+  (0x10A18,0x10A18);
+  (0x10A34,0x10A37);
+  (0x10A3B,0x10A3E);
+  (0x10A48,0x10A4F);
+  (0x10A59,0x10A5F);
+  (0x10AA0,0x10ABF);
+  (0x10AE7,0x10AEA);
+  (0x10AF7,0x10AFF);
+  (0x10B36,0x10B38);
+  (0x10B56,0x10B57);
+  (0x10B73,0x10B77);
+  (0x10B92,0x10B98);
+  (0x10B9D,0x10BA8);
+  (0x10BB0,0x10BFF);
+  (0x10C49,0x10C7F);
+  (0x10CB3,0x10CBF);
+  (0x10CF3,0x10CF9);
+  (0x10D00,0x10E5F);
+  (0x10E7F,0x10FFF);
+  (0x1104E,0x11051);
+  (0x11070,0x1107E);
+  (0x110C2,0x110CF);
+  (0x110E9,0x110EF);
+  (0x110FA,0x110FF);
+  (0x11135,0x11135);
+  (0x11144,0x1114F);
+  (0x11177,0x1117F);
+  (0x111CE,0x111CF);
+  (0x111E0,0x111E0);
+  (0x111F5,0x111FF);
+  (0x11212,0x11212);
+  (0x1123F,0x1127F);
+  (0x11287,0x11287);
+  (0x11289,0x11289);
+  (0x1128E,0x1128E);
+  (0x1129E,0x1129E);
+  (0x112AA,0x112AF);
+  (0x112EB,0x112EF);
+  (0x112FA,0x112FF);
+  (0x11304,0x11304);
+  (0x1130D,0x1130E);
+  (0x11311,0x11312);
+  (0x11329,0x11329);
+  (0x11331,0x11331);
+  (0x11334,0x11334);
+  (0x1133A,0x1133B);
+  (0x11345,0x11346);
+  (0x11349,0x1134A);
+  (0x1134E,0x1134F);
+  (0x11351,0x11356);
+  (0x11358,0x1135C);
+  (0x11364,0x11365);
+  (0x1136D,0x1136F);
+  (0x11375,0x113FF);
+  (0x1145A,0x1145A);
+  (0x1145C,0x1145C);
+  (0x1145E,0x1147F);
+  (0x114C8,0x114CF);
+  (0x114DA,0x1157F);
+  (0x115B6,0x115B7);
+  (0x115DE,0x115FF);
+  (0x11645,0x1164F);
+  (0x1165A,0x1165F);
+  (0x1166D,0x1167F);
+  (0x116B8,0x116BF);
+  (0x116CA,0x116FF);
+  (0x1171A,0x1171C);
+  (0x1172C,0x1172F);
+  (0x11740,0x1189F);
+  (0x118F3,0x118FE);
+  (0x11900,0x11ABF);
+  (0x11AF9,0x11BFF);
+  (0x11C09,0x11C09);
+  (0x11C37,0x11C37);
+  (0x11C46,0x11C4F);
+  (0x11C6D,0x11C6F);
+  (0x11C90,0x11C91);
+  (0x11CA8,0x11CA8);
+  (0x11CB7,0x11FFF);
+  (0x1239A,0x123FF);
+  (0x1246F,0x1246F);
+  (0x12475,0x1247F);
+  (0x12544,0x12FFF);
+  (0x1342F,0x143FF);
+  (0x14647,0x167FF);
+  (0x16A39,0x16A3F);
+  (0x16A5F,0x16A5F);
+  (0x16A6A,0x16A6D);
+  (0x16A70,0x16ACF);
+  (0x16AEE,0x16AEF);
+  (0x16AF6,0x16AFF);
+  (0x16B46,0x16B4F);
+  (0x16B5A,0x16B5A);
+  (0x16B62,0x16B62);
+  (0x16B78,0x16B7C);
+  (0x16B90,0x16EFF);
+  (0x16F45,0x16F4F);
+  (0x16F7F,0x16F8E);
+  (0x16FA0,0x16FDF);
+  (0x16FE1,0x16FFF);
+  (0x187ED,0x187FF);
+  (0x18AF3,0x1AFFF);
+  (0x1B002,0x1BBFF);
+  (0x1BC6B,0x1BC6F);
+  (0x1BC7D,0x1BC7F);
+  (0x1BC89,0x1BC8F);
+  (0x1BC9A,0x1BC9B);
+  (0x1BCA4,0x1CFFF);
   (0x1D0F6,0x1D0FF);
-  (0x1D127,0x1D129);
-  (0x1D1DE,0x1D3FF);
+  (0x1D127,0x1D128);
+  (0x1D1E9,0x1D1FF);
+  (0x1D246,0x1D2FF);
+  (0x1D357,0x1D35F);
+  (0x1D372,0x1D3FF);
   (0x1D455,0x1D455);
   (0x1D49D,0x1D49D);
   (0x1D4A0,0x1D4A1);
@@ -1500,7 +2448,6 @@ let cn = [
   (0x1D4AD,0x1D4AD);
   (0x1D4BA,0x1D4BA);
   (0x1D4BC,0x1D4BC);
-  (0x1D4C1,0x1D4C1);
   (0x1D4C4,0x1D4C4);
   (0x1D506,0x1D506);
   (0x1D50B,0x1D50C);
@@ -1511,63 +2458,195 @@ let cn = [
   (0x1D545,0x1D545);
   (0x1D547,0x1D549);
   (0x1D551,0x1D551);
-  (0x1D6A4,0x1D6A7);
-  (0x1D7CA,0x1D7CD);
-  (0x1D800,0x1FFFF);
-  (0x2A6D7,0x2F7FF);
+  (0x1D6A6,0x1D6A7);
+  (0x1D7CC,0x1D7CD);
+  (0x1DA8C,0x1DA9A);
+  (0x1DAA0,0x1DAA0);
+  (0x1DAB0,0x1DFFF);
+  (0x1E007,0x1E007);
+  (0x1E019,0x1E01A);
+  (0x1E022,0x1E022);
+  (0x1E025,0x1E025);
+  (0x1E02B,0x1E7FF);
+  (0x1E8C5,0x1E8C6);
+  (0x1E8D7,0x1E8FF);
+  (0x1E94B,0x1E94F);
+  (0x1E95A,0x1E95D);
+  (0x1E960,0x1EDFF);
+  (0x1EE04,0x1EE04);
+  (0x1EE20,0x1EE20);
+  (0x1EE23,0x1EE23);
+  (0x1EE25,0x1EE26);
+  (0x1EE28,0x1EE28);
+  (0x1EE33,0x1EE33);
+  (0x1EE38,0x1EE38);
+  (0x1EE3A,0x1EE3A);
+  (0x1EE3C,0x1EE41);
+  (0x1EE43,0x1EE46);
+  (0x1EE48,0x1EE48);
+  (0x1EE4A,0x1EE4A);
+  (0x1EE4C,0x1EE4C);
+  (0x1EE50,0x1EE50);
+  (0x1EE53,0x1EE53);
+  (0x1EE55,0x1EE56);
+  (0x1EE58,0x1EE58);
+  (0x1EE5A,0x1EE5A);
+  (0x1EE5C,0x1EE5C);
+  (0x1EE5E,0x1EE5E);
+  (0x1EE60,0x1EE60);
+  (0x1EE63,0x1EE63);
+  (0x1EE65,0x1EE66);
+  (0x1EE6B,0x1EE6B);
+  (0x1EE73,0x1EE73);
+  (0x1EE78,0x1EE78);
+  (0x1EE7D,0x1EE7D);
+  (0x1EE7F,0x1EE7F);
+  (0x1EE8A,0x1EE8A);
+  (0x1EE9C,0x1EEA0);
+  (0x1EEA4,0x1EEA4);
+  (0x1EEAA,0x1EEAA);
+  (0x1EEBC,0x1EEEF);
+  (0x1EEF2,0x1EFFF);
+  (0x1F02C,0x1F02F);
+  (0x1F094,0x1F09F);
+  (0x1F0AF,0x1F0B0);
+  (0x1F0C0,0x1F0C0);
+  (0x1F0D0,0x1F0D0);
+  (0x1F0F6,0x1F0FF);
+  (0x1F10D,0x1F10F);
+  (0x1F12F,0x1F12F);
+  (0x1F16C,0x1F16F);
+  (0x1F1AD,0x1F1E5);
+  (0x1F203,0x1F20F);
+  (0x1F23C,0x1F23F);
+  (0x1F249,0x1F24F);
+  (0x1F252,0x1F2FF);
+  (0x1F6D3,0x1F6DF);
+  (0x1F6ED,0x1F6EF);
+  (0x1F6F7,0x1F6FF);
+  (0x1F774,0x1F77F);
+  (0x1F7D5,0x1F7FF);
+  (0x1F80C,0x1F80F);
+  (0x1F848,0x1F84F);
+  (0x1F85A,0x1F85F);
+  (0x1F888,0x1F88F);
+  (0x1F8AE,0x1F90F);
+  (0x1F91F,0x1F91F);
+  (0x1F928,0x1F92F);
+  (0x1F931,0x1F932);
+  (0x1F93F,0x1F93F);
+  (0x1F94C,0x1F94F);
+  (0x1F95F,0x1F97F);
+  (0x1F992,0x1F9BF);
+  (0x1F9C1,0x1FFFF);
+  (0x2A6D7,0x2A6FF);
+  (0x2B735,0x2B73F);
+  (0x2B81E,0x2B81F);
+  (0x2CEA2,0x2F7FF);
   (0x2FA1E,0xE0000);
   (0xE0002,0xE001F);
-  (0xE0080,0x7FFFFFFF)
+  (0xE0080,0xE00FF);
+  (0xE01F0,0xEFFFF);
+  (0xFFFFE,0xFFFFF)
 ]
 (* Letter, Modifier *)
 let lm = [
-  (0x002B0,0x002B8);
-  (0x002BB,0x002C1);
-  (0x002D0,0x002D1);
+  (0x002B0,0x002C1);
+  (0x002C6,0x002D1);
   (0x002E0,0x002E4);
+  (0x002EC,0x002EC);
   (0x002EE,0x002EE);
+  (0x00374,0x00374);
   (0x0037A,0x0037A);
   (0x00559,0x00559);
   (0x00640,0x00640);
   (0x006E5,0x006E6);
+  (0x007F4,0x007F5);
+  (0x007FA,0x007FA);
+  (0x0081A,0x0081A);
+  (0x00824,0x00824);
+  (0x00828,0x00828);
+  (0x00971,0x00971);
   (0x00E46,0x00E46);
   (0x00EC6,0x00EC6);
+  (0x010FC,0x010FC);
   (0x017D7,0x017D7);
   (0x01843,0x01843);
+  (0x01AA7,0x01AA7);
+  (0x01C78,0x01C7D);
+  (0x01D2C,0x01D6A);
+  (0x01D78,0x01D78);
+  (0x01D9B,0x01DBF);
+  (0x02071,0x02071);
+  (0x0207F,0x0207F);
+  (0x02090,0x0209C);
+  (0x02C7C,0x02C7D);
+  (0x02D6F,0x02D6F);
+  (0x02E2F,0x02E2F);
   (0x03005,0x03005);
   (0x03031,0x03035);
   (0x0303B,0x0303B);
   (0x0309D,0x0309E);
   (0x030FC,0x030FE);
+  (0x0A015,0x0A015);
+  (0x0A4F8,0x0A4FD);
+  (0x0A60C,0x0A60C);
+  (0x0A67F,0x0A67F);
+  (0x0A69C,0x0A69D);
+  (0x0A717,0x0A71F);
+  (0x0A770,0x0A770);
+  (0x0A788,0x0A788);
+  (0x0A7F8,0x0A7F9);
+  (0x0A9CF,0x0A9CF);
+  (0x0A9E6,0x0A9E6);
+  (0x0AA70,0x0AA70);
+  (0x0AADD,0x0AADD);
+  (0x0AAF3,0x0AAF4);
+  (0x0AB5C,0x0AB5F);
   (0x0FF70,0x0FF70);
-  (0x0FF9E,0x0FF9F)
+  (0x0FF9E,0x0FF9F);
+  (0x16B40,0x16B43);
+  (0x16F93,0x16F9F)
 ]
 (* Letter, Other *)
 let lo = [
+  (0x000AA,0x000AA);
+  (0x000BA,0x000BA);
   (0x001BB,0x001BB);
   (0x001C0,0x001C3);
+  (0x00294,0x00294);
   (0x005D0,0x005EA);
   (0x005F0,0x005F2);
-  (0x00621,0x0063A);
+  (0x00620,0x0063F);
   (0x00641,0x0064A);
   (0x0066E,0x0066F);
   (0x00671,0x006D3);
   (0x006D5,0x006D5);
+  (0x006EE,0x006EF);
   (0x006FA,0x006FC);
+  (0x006FF,0x006FF);
   (0x00710,0x00710);
-  (0x00712,0x0072C);
-  (0x00780,0x007A5);
+  (0x00712,0x0072F);
+  (0x0074D,0x007A5);
   (0x007B1,0x007B1);
-  (0x00905,0x00939);
+  (0x007CA,0x007EA);
+  (0x00800,0x00815);
+  (0x00840,0x00858);
+  (0x008A0,0x008B4);
+  (0x008B6,0x008BD);
+  (0x00904,0x00939);
   (0x0093D,0x0093D);
   (0x00950,0x00950);
   (0x00958,0x00961);
+  (0x00972,0x00980);
   (0x00985,0x0098C);
   (0x0098F,0x00990);
   (0x00993,0x009A8);
   (0x009AA,0x009B0);
   (0x009B2,0x009B2);
   (0x009B6,0x009B9);
+  (0x009BD,0x009BD);
+  (0x009CE,0x009CE);
   (0x009DC,0x009DD);
   (0x009DF,0x009E1);
   (0x009F0,0x009F1);
@@ -1581,8 +2660,7 @@ let lo = [
   (0x00A59,0x00A5C);
   (0x00A5E,0x00A5E);
   (0x00A72,0x00A74);
-  (0x00A85,0x00A8B);
-  (0x00A8D,0x00A8D);
+  (0x00A85,0x00A8D);
   (0x00A8F,0x00A91);
   (0x00A93,0x00AA8);
   (0x00AAA,0x00AB0);
@@ -1590,16 +2668,18 @@ let lo = [
   (0x00AB5,0x00AB9);
   (0x00ABD,0x00ABD);
   (0x00AD0,0x00AD0);
-  (0x00AE0,0x00AE0);
+  (0x00AE0,0x00AE1);
+  (0x00AF9,0x00AF9);
   (0x00B05,0x00B0C);
   (0x00B0F,0x00B10);
   (0x00B13,0x00B28);
   (0x00B2A,0x00B30);
   (0x00B32,0x00B33);
-  (0x00B36,0x00B39);
+  (0x00B35,0x00B39);
   (0x00B3D,0x00B3D);
   (0x00B5C,0x00B5D);
   (0x00B5F,0x00B61);
+  (0x00B71,0x00B71);
   (0x00B83,0x00B83);
   (0x00B85,0x00B8A);
   (0x00B8E,0x00B90);
@@ -1609,26 +2689,33 @@ let lo = [
   (0x00B9E,0x00B9F);
   (0x00BA3,0x00BA4);
   (0x00BA8,0x00BAA);
-  (0x00BAE,0x00BB5);
-  (0x00BB7,0x00BB9);
+  (0x00BAE,0x00BB9);
+  (0x00BD0,0x00BD0);
   (0x00C05,0x00C0C);
   (0x00C0E,0x00C10);
   (0x00C12,0x00C28);
-  (0x00C2A,0x00C33);
-  (0x00C35,0x00C39);
+  (0x00C2A,0x00C39);
+  (0x00C3D,0x00C3D);
+  (0x00C58,0x00C5A);
   (0x00C60,0x00C61);
+  (0x00C80,0x00C80);
   (0x00C85,0x00C8C);
   (0x00C8E,0x00C90);
   (0x00C92,0x00CA8);
   (0x00CAA,0x00CB3);
   (0x00CB5,0x00CB9);
+  (0x00CBD,0x00CBD);
   (0x00CDE,0x00CDE);
   (0x00CE0,0x00CE1);
+  (0x00CF1,0x00CF2);
   (0x00D05,0x00D0C);
   (0x00D0E,0x00D10);
-  (0x00D12,0x00D28);
-  (0x00D2A,0x00D39);
-  (0x00D60,0x00D61);
+  (0x00D12,0x00D3A);
+  (0x00D3D,0x00D3D);
+  (0x00D4E,0x00D4E);
+  (0x00D54,0x00D56);
+  (0x00D5F,0x00D61);
+  (0x00D7A,0x00D7F);
   (0x00D85,0x00D96);
   (0x00D9A,0x00DB1);
   (0x00DB3,0x00DBB);
@@ -1652,49 +2739,43 @@ let lo = [
   (0x00EB2,0x00EB3);
   (0x00EBD,0x00EBD);
   (0x00EC0,0x00EC4);
-  (0x00EDC,0x00EDD);
+  (0x00EDC,0x00EDF);
   (0x00F00,0x00F00);
   (0x00F40,0x00F47);
-  (0x00F49,0x00F6A);
-  (0x00F88,0x00F8B);
-  (0x01000,0x01021);
-  (0x01023,0x01027);
-  (0x01029,0x0102A);
+  (0x00F49,0x00F6C);
+  (0x00F88,0x00F8C);
+  (0x01000,0x0102A);
+  (0x0103F,0x0103F);
   (0x01050,0x01055);
-  (0x010D0,0x010F8);
-  (0x01100,0x01159);
-  (0x0115F,0x011A2);
-  (0x011A8,0x011F9);
-  (0x01200,0x01206);
-  (0x01208,0x01246);
-  (0x01248,0x01248);
+  (0x0105A,0x0105D);
+  (0x01061,0x01061);
+  (0x01065,0x01066);
+  (0x0106E,0x01070);
+  (0x01075,0x01081);
+  (0x0108E,0x0108E);
+  (0x010D0,0x010FA);
+  (0x010FD,0x01248);
   (0x0124A,0x0124D);
   (0x01250,0x01256);
   (0x01258,0x01258);
   (0x0125A,0x0125D);
-  (0x01260,0x01286);
-  (0x01288,0x01288);
+  (0x01260,0x01288);
   (0x0128A,0x0128D);
-  (0x01290,0x012AE);
-  (0x012B0,0x012B0);
+  (0x01290,0x012B0);
   (0x012B2,0x012B5);
   (0x012B8,0x012BE);
   (0x012C0,0x012C0);
   (0x012C2,0x012C5);
-  (0x012C8,0x012CE);
-  (0x012D0,0x012D6);
-  (0x012D8,0x012EE);
-  (0x012F0,0x0130E);
-  (0x01310,0x01310);
+  (0x012C8,0x012D6);
+  (0x012D8,0x01310);
   (0x01312,0x01315);
-  (0x01318,0x0131E);
-  (0x01320,0x01346);
-  (0x01348,0x0135A);
-  (0x013A0,0x013F4);
+  (0x01318,0x0135A);
+  (0x01380,0x0138F);
   (0x01401,0x0166C);
-  (0x0166F,0x01676);
+  (0x0166F,0x0167F);
   (0x01681,0x0169A);
   (0x016A0,0x016EA);
+  (0x016F1,0x016F8);
   (0x01700,0x0170C);
   (0x0170E,0x01711);
   (0x01720,0x01731);
@@ -1705,24 +2786,103 @@ let lo = [
   (0x017DC,0x017DC);
   (0x01820,0x01842);
   (0x01844,0x01877);
-  (0x01880,0x018A8);
+  (0x01880,0x01884);
+  (0x01887,0x018A8);
+  (0x018AA,0x018AA);
+  (0x018B0,0x018F5);
+  (0x01900,0x0191E);
+  (0x01950,0x0196D);
+  (0x01970,0x01974);
+  (0x01980,0x019AB);
+  (0x019B0,0x019C9);
+  (0x01A00,0x01A16);
+  (0x01A20,0x01A54);
+  (0x01B05,0x01B33);
+  (0x01B45,0x01B4B);
+  (0x01B83,0x01BA0);
+  (0x01BAE,0x01BAF);
+  (0x01BBA,0x01BE5);
+  (0x01C00,0x01C23);
+  (0x01C4D,0x01C4F);
+  (0x01C5A,0x01C77);
+  (0x01CE9,0x01CEC);
+  (0x01CEE,0x01CF1);
+  (0x01CF5,0x01CF6);
   (0x02135,0x02138);
+  (0x02D30,0x02D67);
+  (0x02D80,0x02D96);
+  (0x02DA0,0x02DA6);
+  (0x02DA8,0x02DAE);
+  (0x02DB0,0x02DB6);
+  (0x02DB8,0x02DBE);
+  (0x02DC0,0x02DC6);
+  (0x02DC8,0x02DCE);
+  (0x02DD0,0x02DD6);
+  (0x02DD8,0x02DDE);
   (0x03006,0x03006);
   (0x0303C,0x0303C);
   (0x03041,0x03096);
   (0x0309F,0x0309F);
   (0x030A1,0x030FA);
   (0x030FF,0x030FF);
-  (0x03105,0x0312C);
+  (0x03105,0x0312D);
   (0x03131,0x0318E);
-  (0x031A0,0x031B7);
+  (0x031A0,0x031BA);
   (0x031F0,0x031FF);
   (0x03400,0x04DB5);
-  (0x04E00,0x09FA5);
-  (0x0A000,0x0A48C);
+  (0x04E00,0x09FD5);
+  (0x0A000,0x0A014);
+  (0x0A016,0x0A48C);
+  (0x0A4D0,0x0A4F7);
+  (0x0A500,0x0A60B);
+  (0x0A610,0x0A61F);
+  (0x0A62A,0x0A62B);
+  (0x0A66E,0x0A66E);
+  (0x0A6A0,0x0A6E5);
+  (0x0A78F,0x0A78F);
+  (0x0A7F7,0x0A7F7);
+  (0x0A7FB,0x0A801);
+  (0x0A803,0x0A805);
+  (0x0A807,0x0A80A);
+  (0x0A80C,0x0A822);
+  (0x0A840,0x0A873);
+  (0x0A882,0x0A8B3);
+  (0x0A8F2,0x0A8F7);
+  (0x0A8FB,0x0A8FB);
+  (0x0A8FD,0x0A8FD);
+  (0x0A90A,0x0A925);
+  (0x0A930,0x0A946);
+  (0x0A960,0x0A97C);
+  (0x0A984,0x0A9B2);
+  (0x0A9E0,0x0A9E4);
+  (0x0A9E7,0x0A9EF);
+  (0x0A9FA,0x0A9FE);
+  (0x0AA00,0x0AA28);
+  (0x0AA40,0x0AA42);
+  (0x0AA44,0x0AA4B);
+  (0x0AA60,0x0AA6F);
+  (0x0AA71,0x0AA76);
+  (0x0AA7A,0x0AA7A);
+  (0x0AA7E,0x0AAAF);
+  (0x0AAB1,0x0AAB1);
+  (0x0AAB5,0x0AAB6);
+  (0x0AAB9,0x0AABD);
+  (0x0AAC0,0x0AAC0);
+  (0x0AAC2,0x0AAC2);
+  (0x0AADB,0x0AADC);
+  (0x0AAE0,0x0AAEA);
+  (0x0AAF2,0x0AAF2);
+  (0x0AB01,0x0AB06);
+  (0x0AB09,0x0AB0E);
+  (0x0AB11,0x0AB16);
+  (0x0AB20,0x0AB26);
+  (0x0AB28,0x0AB2E);
+  (0x0ABC0,0x0ABE2);
   (0x0AC00,0x0D7A3);
-  (0x0F900,0x0FA2D);
-  (0x0FA30,0x0FA6A);
+  (0x0D7B0,0x0D7C6);
+  (0x0D7CB,0x0D7FB);
+  (0x0F900,0x0FA6D);
+  (0x0FA70,0x0FAD9);
   (0x0FB1D,0x0FB1D);
   (0x0FB1F,0x0FB28);
   (0x0FB2A,0x0FB36);
@@ -1744,35 +2904,183 @@ let lo = [
   (0x0FFCA,0x0FFCF);
   (0x0FFD2,0x0FFD7);
   (0x0FFDA,0x0FFDC);
-  (0x10300,0x1031E);
-  (0x10330,0x10349);
+  (0x10000,0x1000B);
+  (0x1000D,0x10026);
+  (0x10028,0x1003A);
+  (0x1003C,0x1003D);
+  (0x1003F,0x1004D);
+  (0x10050,0x1005D);
+  (0x10080,0x100FA);
+  (0x10280,0x1029C);
+  (0x102A0,0x102D0);
+  (0x10300,0x1031F);
+  (0x10330,0x10340);
+  (0x10342,0x10349);
+  (0x10350,0x10375);
+  (0x10380,0x1039D);
+  (0x103A0,0x103C3);
+  (0x103C8,0x103CF);
+  (0x10450,0x1049D);
+  (0x10500,0x10527);
+  (0x10530,0x10563);
+  (0x10600,0x10736);
+  (0x10740,0x10755);
+  (0x10760,0x10767);
+  (0x10800,0x10805);
+  (0x10808,0x10808);
+  (0x1080A,0x10835);
+  (0x10837,0x10838);
+  (0x1083C,0x1083C);
+  (0x1083F,0x10855);
+  (0x10860,0x10876);
+  (0x10880,0x1089E);
+  (0x108E0,0x108F2);
+  (0x108F4,0x108F5);
+  (0x10900,0x10915);
+  (0x10920,0x10939);
+  (0x10980,0x109B7);
+  (0x109BE,0x109BF);
+  (0x10A00,0x10A00);
+  (0x10A10,0x10A13);
+  (0x10A15,0x10A17);
+  (0x10A19,0x10A33);
+  (0x10A60,0x10A7C);
+  (0x10A80,0x10A9C);
+  (0x10AC0,0x10AC7);
+  (0x10AC9,0x10AE4);
+  (0x10B00,0x10B35);
+  (0x10B40,0x10B55);
+  (0x10B60,0x10B72);
+  (0x10B80,0x10B91);
+  (0x10C00,0x10C48);
+  (0x11003,0x11037);
+  (0x11083,0x110AF);
+  (0x110D0,0x110E8);
+  (0x11103,0x11126);
+  (0x11150,0x11172);
+  (0x11176,0x11176);
+  (0x11183,0x111B2);
+  (0x111C1,0x111C4);
+  (0x111DA,0x111DA);
+  (0x111DC,0x111DC);
+  (0x11200,0x11211);
+  (0x11213,0x1122B);
+  (0x11280,0x11286);
+  (0x11288,0x11288);
+  (0x1128A,0x1128D);
+  (0x1128F,0x1129D);
+  (0x1129F,0x112A8);
+  (0x112B0,0x112DE);
+  (0x11305,0x1130C);
+  (0x1130F,0x11310);
+  (0x11313,0x11328);
+  (0x1132A,0x11330);
+  (0x11332,0x11333);
+  (0x11335,0x11339);
+  (0x1133D,0x1133D);
+  (0x11350,0x11350);
+  (0x1135D,0x11361);
+  (0x11400,0x11434);
+  (0x11447,0x1144A);
+  (0x11480,0x114AF);
+  (0x114C4,0x114C5);
+  (0x114C7,0x114C7);
+  (0x11580,0x115AE);
+  (0x115D8,0x115DB);
+  (0x11600,0x1162F);
+  (0x11644,0x11644);
+  (0x11680,0x116AA);
+  (0x11700,0x11719);
+  (0x118FF,0x118FF);
+  (0x11AC0,0x11AF8);
+  (0x11C00,0x11C08);
+  (0x11C0A,0x11C2E);
+  (0x11C40,0x11C40);
+  (0x11C72,0x11C8F);
+  (0x12000,0x12399);
+  (0x12480,0x12543);
+  (0x13000,0x1342E);
+  (0x14400,0x14646);
+  (0x16800,0x16A38);
+  (0x16A40,0x16A5E);
+  (0x16AD0,0x16AED);
+  (0x16B00,0x16B2F);
+  (0x16B63,0x16B77);
+  (0x16B7D,0x16B8F);
+  (0x16F00,0x16F44);
+  (0x16F50,0x16F50);
+  (0x17000,0x187EC);
+  (0x18800,0x18AF2);
+  (0x1B000,0x1B001);
+  (0x1BC00,0x1BC6A);
+  (0x1BC70,0x1BC7C);
+  (0x1BC80,0x1BC88);
+  (0x1BC90,0x1BC99);
+  (0x1E800,0x1E8C4);
+  (0x1EE00,0x1EE03);
+  (0x1EE05,0x1EE1F);
+  (0x1EE21,0x1EE22);
+  (0x1EE24,0x1EE24);
+  (0x1EE27,0x1EE27);
+  (0x1EE29,0x1EE32);
+  (0x1EE34,0x1EE37);
+  (0x1EE39,0x1EE39);
+  (0x1EE3B,0x1EE3B);
+  (0x1EE42,0x1EE42);
+  (0x1EE47,0x1EE47);
+  (0x1EE49,0x1EE49);
+  (0x1EE4B,0x1EE4B);
+  (0x1EE4D,0x1EE4F);
+  (0x1EE51,0x1EE52);
+  (0x1EE54,0x1EE54);
+  (0x1EE57,0x1EE57);
+  (0x1EE59,0x1EE59);
+  (0x1EE5B,0x1EE5B);
+  (0x1EE5D,0x1EE5D);
+  (0x1EE5F,0x1EE5F);
+  (0x1EE61,0x1EE62);
+  (0x1EE64,0x1EE64);
+  (0x1EE67,0x1EE6A);
+  (0x1EE6C,0x1EE72);
+  (0x1EE74,0x1EE77);
+  (0x1EE79,0x1EE7C);
+  (0x1EE7E,0x1EE7E);
+  (0x1EE80,0x1EE89);
+  (0x1EE8B,0x1EE9B);
+  (0x1EEA1,0x1EEA3);
+  (0x1EEA5,0x1EEA9);
+  (0x1EEAB,0x1EEBB);
   (0x20000,0x2A6D6);
-  (0x2F800,0x2FA1D)
+  (0x2A700,0x2B734);
+  (0x2B740,0x2B81D);
+  (0x2B820,0x2CEA1)
 ]
 (* Punctuation, Connector *)
 let pc = [
   (0x0005F,0x0005F);
   (0x0203F,0x02040);
-  (0x030FB,0x030FB);
+  (0x02054,0x02054);
   (0x0FE33,0x0FE34);
-  (0x0FE4D,0x0FE4F);
-  (0x0FF3F,0x0FF3F);
-  (0x0FF65,0x0FF65)
+  (0x0FE4D,0x0FE4F)
 ]
 (* Punctuation, Dash *)
 let pd = [
   (0x0002D,0x0002D);
-  (0x000AD,0x000AD);
   (0x0058A,0x0058A);
+  (0x005BE,0x005BE);
+  (0x01400,0x01400);
   (0x01806,0x01806);
   (0x02010,0x02015);
+  (0x02E17,0x02E17);
+  (0x02E1A,0x02E1A);
+  (0x02E3A,0x02E3B);
+  (0x02E40,0x02E40);
   (0x0301C,0x0301C);
   (0x03030,0x03030);
   (0x030A0,0x030A0);
   (0x0FE31,0x0FE32);
   (0x0FE58,0x0FE58);
-  (0x0FE63,0x0FE63);
-  (0x0FF0D,0x0FF0D)
+  (0x0FE63,0x0FE63)
 ]
 (* Punctuation, Open *)
 let ps = [
@@ -1787,8 +3095,9 @@ let ps = [
   (0x02045,0x02045);
   (0x0207D,0x0207D);
   (0x0208D,0x0208D);
+  (0x02308,0x02308);
+  (0x0230A,0x0230A);
   (0x02329,0x02329);
-  (0x023B4,0x023B4);
   (0x02768,0x02768);
   (0x0276A,0x0276A);
   (0x0276C,0x0276C);
@@ -1796,9 +3105,12 @@ let ps = [
   (0x02770,0x02770);
   (0x02772,0x02772);
   (0x02774,0x02774);
+  (0x027C5,0x027C5);
   (0x027E6,0x027E6);
   (0x027E8,0x027E8);
   (0x027EA,0x027EA);
+  (0x027EC,0x027EC);
+  (0x027EE,0x027EE);
   (0x02983,0x02983);
   (0x02985,0x02985);
   (0x02987,0x02987);
@@ -1813,6 +3125,11 @@ let ps = [
   (0x029D8,0x029D8);
   (0x029DA,0x029DA);
   (0x029FC,0x029FC);
+  (0x02E22,0x02E22);
+  (0x02E24,0x02E24);
+  (0x02E26,0x02E26);
+  (0x02E28,0x02E28);
+  (0x02E42,0x02E42);
   (0x03008,0x03008);
   (0x0300A,0x0300A);
   (0x0300C,0x0300C);
@@ -1823,7 +3140,8 @@ let ps = [
   (0x03018,0x03018);
   (0x0301A,0x0301A);
   (0x0301D,0x0301D);
-  (0x0FD3E,0x0FD3E);
+  (0x0FD3F,0x0FD3F);
+  (0x0FE17,0x0FE17);
   (0x0FE35,0x0FE35);
   (0x0FE37,0x0FE37);
   (0x0FE39,0x0FE39);
@@ -1832,14 +3150,14 @@ let ps = [
   (0x0FE3F,0x0FE3F);
   (0x0FE41,0x0FE41);
   (0x0FE43,0x0FE43);
+  (0x0FE47,0x0FE47);
   (0x0FE59,0x0FE59);
   (0x0FE5B,0x0FE5B);
   (0x0FE5D,0x0FE5D);
   (0x0FF08,0x0FF08);
   (0x0FF3B,0x0FF3B);
   (0x0FF5B,0x0FF5B);
-  (0x0FF5F,0x0FF5F);
-  (0x0FF62,0x0FF62)
+  (0x0FF5F,0x0FF5F)
 ]
 (* Punctuation, Close *)
 let pe = [
@@ -1852,8 +3170,9 @@ let pe = [
   (0x02046,0x02046);
   (0x0207E,0x0207E);
   (0x0208E,0x0208E);
+  (0x02309,0x02309);
+  (0x0230B,0x0230B);
   (0x0232A,0x0232A);
-  (0x023B5,0x023B5);
   (0x02769,0x02769);
   (0x0276B,0x0276B);
   (0x0276D,0x0276D);
@@ -1861,9 +3180,12 @@ let pe = [
   (0x02771,0x02771);
   (0x02773,0x02773);
   (0x02775,0x02775);
+  (0x027C6,0x027C6);
   (0x027E7,0x027E7);
   (0x027E9,0x027E9);
   (0x027EB,0x027EB);
+  (0x027ED,0x027ED);
+  (0x027EF,0x027EF);
   (0x02984,0x02984);
   (0x02986,0x02986);
   (0x02988,0x02988);
@@ -1878,6 +3200,10 @@ let pe = [
   (0x029D9,0x029D9);
   (0x029DB,0x029DB);
   (0x029FD,0x029FD);
+  (0x02E23,0x02E23);
+  (0x02E25,0x02E25);
+  (0x02E27,0x02E27);
+  (0x02E29,0x02E29);
   (0x03009,0x03009);
   (0x0300B,0x0300B);
   (0x0300D,0x0300D);
@@ -1888,7 +3214,8 @@ let pe = [
   (0x03019,0x03019);
   (0x0301B,0x0301B);
   (0x0301E,0x0301F);
-  (0x0FD3F,0x0FD3F);
+  (0x0FD3E,0x0FD3E);
+  (0x0FE18,0x0FE18);
   (0x0FE36,0x0FE36);
   (0x0FE38,0x0FE38);
   (0x0FE3A,0x0FE3A);
@@ -1897,14 +3224,14 @@ let pe = [
   (0x0FE40,0x0FE40);
   (0x0FE42,0x0FE42);
   (0x0FE44,0x0FE44);
+  (0x0FE48,0x0FE48);
   (0x0FE5A,0x0FE5A);
   (0x0FE5C,0x0FE5C);
   (0x0FE5E,0x0FE5E);
   (0x0FF09,0x0FF09);
   (0x0FF3D,0x0FF3D);
   (0x0FF5D,0x0FF5D);
-  (0x0FF60,0x0FF60);
-  (0x0FF63,0x0FF63)
+  (0x0FF60,0x0FF60)
 ]
 (* Punctuation, Initial quote  *)
 let pi = [
@@ -1912,14 +3239,24 @@ let pi = [
   (0x02018,0x02018);
   (0x0201B,0x0201C);
   (0x0201F,0x0201F);
-  (0x02039,0x02039)
+  (0x02039,0x02039);
+  (0x02E02,0x02E02);
+  (0x02E04,0x02E04);
+  (0x02E09,0x02E09);
+  (0x02E0C,0x02E0C);
+  (0x02E1C,0x02E1C)
 ]
 (* Punctuation, Final quote  *)
 let pf = [
   (0x000BB,0x000BB);
   (0x02019,0x02019);
   (0x0201D,0x0201D);
-  (0x0203A,0x0203A)
+  (0x0203A,0x0203A);
+  (0x02E03,0x02E03);
+  (0x02E05,0x02E05);
+  (0x02E0A,0x02E0A);
+  (0x02E0D,0x02E0D);
+  (0x02E1D,0x02E1D)
 ]
 (* Punctuation, Other *)
 let po = [
@@ -1932,32 +3269,41 @@ let po = [
   (0x0003F,0x00040);
   (0x0005C,0x0005C);
   (0x000A1,0x000A1);
-  (0x000B7,0x000B7);
+  (0x000A7,0x000A7);
+  (0x000B6,0x000B7);
   (0x000BF,0x000BF);
   (0x0037E,0x0037E);
   (0x00387,0x00387);
   (0x0055A,0x0055F);
   (0x00589,0x00589);
-  (0x005BE,0x005BE);
   (0x005C0,0x005C0);
   (0x005C3,0x005C3);
+  (0x005C6,0x005C6);
   (0x005F3,0x005F4);
-  (0x0060C,0x0060C);
+  (0x00609,0x0060A);
+  (0x0060C,0x0060D);
   (0x0061B,0x0061B);
-  (0x0061F,0x0061F);
+  (0x0061E,0x0061F);
   (0x0066A,0x0066D);
   (0x006D4,0x006D4);
   (0x00700,0x0070D);
+  (0x007F7,0x007F9);
+  (0x00830,0x0083E);
+  (0x0085E,0x0085E);
   (0x00964,0x00965);
   (0x00970,0x00970);
+  (0x00AF0,0x00AF0);
   (0x00DF4,0x00DF4);
   (0x00E4F,0x00E4F);
   (0x00E5A,0x00E5B);
   (0x00F04,0x00F12);
+  (0x00F14,0x00F14);
   (0x00F85,0x00F85);
+  (0x00FD0,0x00FD4);
+  (0x00FD9,0x00FDA);
   (0x0104A,0x0104F);
   (0x010FB,0x010FB);
-  (0x01361,0x01368);
+  (0x01360,0x01368);
   (0x0166D,0x0166E);
   (0x016EB,0x016ED);
   (0x01735,0x01736);
@@ -1965,16 +3311,61 @@ let po = [
   (0x017D8,0x017DA);
   (0x01800,0x01805);
   (0x01807,0x0180A);
+  (0x01944,0x01945);
+  (0x01A1E,0x01A1F);
+  (0x01AA0,0x01AA6);
+  (0x01AA8,0x01AAD);
+  (0x01B5A,0x01B60);
+  (0x01BFC,0x01BFF);
+  (0x01C3B,0x01C3F);
+  (0x01C7E,0x01C7F);
+  (0x01CC0,0x01CC7);
+  (0x01CD3,0x01CD3);
   (0x02016,0x02017);
   (0x02020,0x02027);
   (0x02030,0x02038);
   (0x0203B,0x0203E);
   (0x02041,0x02043);
   (0x02047,0x02051);
-  (0x02057,0x02057);
-  (0x023B6,0x023B6);
+  (0x02053,0x02053);
+  (0x02055,0x0205E);
+  (0x02CF9,0x02CFC);
+  (0x02CFE,0x02CFF);
+  (0x02D70,0x02D70);
+  (0x02E00,0x02E01);
+  (0x02E06,0x02E08);
+  (0x02E0B,0x02E0B);
+  (0x02E0E,0x02E16);
+  (0x02E18,0x02E19);
+  (0x02E1B,0x02E1B);
+  (0x02E1E,0x02E1F);
+  (0x02E2A,0x02E2E);
+  (0x02E30,0x02E39);
+  (0x02E3C,0x02E3F);
+  (0x02E41,0x02E41);
+  (0x02E43,0x02E44);
   (0x03001,0x03003);
   (0x0303D,0x0303D);
+  (0x030FB,0x030FB);
+  (0x0A4FE,0x0A4FF);
+  (0x0A60D,0x0A60F);
+  (0x0A673,0x0A673);
+  (0x0A67E,0x0A67E);
+  (0x0A6F2,0x0A6F7);
+  (0x0A874,0x0A877);
+  (0x0A8CE,0x0A8CF);
+  (0x0A8F8,0x0A8FA);
+  (0x0A8FC,0x0A8FC);
+  (0x0A92E,0x0A92F);
+  (0x0A95F,0x0A95F);
+  (0x0A9C1,0x0A9CD);
+  (0x0A9DE,0x0A9DF);
+  (0x0AA5C,0x0AA5F);
+  (0x0AADE,0x0AADF);
+  (0x0AAF0,0x0AAF1);
+  (0x0ABEB,0x0ABEB);
+  (0x0FE10,0x0FE16);
+  (0x0FE19,0x0FE19);
   (0x0FE30,0x0FE30);
   (0x0FE45,0x0FE46);
   (0x0FE49,0x0FE4C);
@@ -1992,7 +3383,47 @@ let po = [
   (0x0FF1F,0x0FF20);
   (0x0FF3C,0x0FF3C);
   (0x0FF61,0x0FF61);
-  (0x0FF64,0x0FF64)
+  (0x0FF64,0x0FF65);
+  (0x10100,0x10102);
+  (0x1039F,0x1039F);
+  (0x103D0,0x103D0);
+  (0x1056F,0x1056F);
+  (0x10857,0x10857);
+  (0x1091F,0x1091F);
+  (0x1093F,0x1093F);
+  (0x10A50,0x10A58);
+  (0x10A7F,0x10A7F);
+  (0x10AF0,0x10AF6);
+  (0x10B39,0x10B3F);
+  (0x10B99,0x10B9C);
+  (0x11047,0x1104D);
+  (0x110BB,0x110BC);
+  (0x110BE,0x110C1);
+  (0x11140,0x11143);
+  (0x11174,0x11175);
+  (0x111C5,0x111C9);
+  (0x111CD,0x111CD);
+  (0x111DB,0x111DB);
+  (0x111DD,0x111DF);
+  (0x11238,0x1123D);
+  (0x112A9,0x112A9);
+  (0x1144B,0x1144F);
+  (0x1145B,0x1145B);
+  (0x1145D,0x1145D);
+  (0x114C6,0x114C6);
+  (0x115C1,0x115D7);
+  (0x11641,0x11643);
+  (0x11660,0x1166C);
+  (0x1173C,0x1173E);
+  (0x11C41,0x11C45);
+  (0x11C70,0x11C71);
+  (0x12470,0x12474);
+  (0x16A6E,0x16A6F);
+  (0x16AF5,0x16AF5);
+  (0x16B37,0x16B3B);
+  (0x16B44,0x16B44);
+  (0x1BC9F,0x1BC9F);
+  (0x1DA87,0x1DA8B)
 ]
 (* Symbol, Math *)
 let sm = [
@@ -2005,10 +3436,12 @@ let sm = [
   (0x000D7,0x000D7);
   (0x000F7,0x000F7);
   (0x003F6,0x003F6);
+  (0x00606,0x00608);
   (0x02044,0x02044);
   (0x02052,0x02052);
   (0x0207A,0x0207C);
   (0x0208A,0x0208C);
+  (0x02118,0x02118);
   (0x02140,0x02144);
   (0x0214B,0x0214B);
   (0x02190,0x02194);
@@ -2021,20 +3454,23 @@ let sm = [
   (0x021D2,0x021D2);
   (0x021D4,0x021D4);
   (0x021F4,0x022FF);
-  (0x02308,0x0230B);
   (0x02320,0x02321);
   (0x0237C,0x0237C);
   (0x0239B,0x023B3);
+  (0x023DC,0x023E1);
   (0x025B7,0x025B7);
   (0x025C1,0x025C1);
   (0x025F8,0x025FF);
   (0x0266F,0x0266F);
-  (0x027D0,0x027E5);
+  (0x027C0,0x027C4);
+  (0x027C7,0x027E5);
   (0x027F0,0x027FF);
   (0x02900,0x02982);
   (0x02999,0x029D7);
   (0x029DC,0x029FB);
   (0x029FE,0x02AFF);
+  (0x02B30,0x02B44);
+  (0x02B47,0x02B4C);
   (0x0FB29,0x0FB29);
   (0x0FE62,0x0FE62);
   (0x0FE64,0x0FE66);
@@ -2059,15 +3495,20 @@ let sm = [
 let sc = [
   (0x00024,0x00024);
   (0x000A2,0x000A5);
+  (0x0058F,0x0058F);
+  (0x0060B,0x0060B);
   (0x009F2,0x009F3);
+  (0x009FB,0x009FB);
+  (0x00AF1,0x00AF1);
+  (0x00BF9,0x00BF9);
   (0x00E3F,0x00E3F);
   (0x017DB,0x017DB);
-  (0x020A0,0x020B1);
+  (0x020A0,0x020BE);
+  (0x0A838,0x0A838);
   (0x0FDFC,0x0FDFC);
   (0x0FE69,0x0FE69);
   (0x0FF04,0x0FF04);
-  (0x0FFE0,0x0FFE1);
-  (0x0FFE5,0x0FFE6)
+  (0x0FFE0,0x0FFE1)
 ]
 (* Symbol, Modifier *)
 let sk = [
@@ -2077,11 +3518,12 @@ let sk = [
   (0x000AF,0x000AF);
   (0x000B4,0x000B4);
   (0x000B8,0x000B8);
-  (0x002B9,0x002BA);
-  (0x002C2,0x002CF);
+  (0x002C2,0x002C5);
   (0x002D2,0x002DF);
-  (0x002E5,0x002ED);
-  (0x00374,0x00375);
+  (0x002E5,0x002EB);
+  (0x002ED,0x002ED);
+  (0x002EF,0x002FF);
+  (0x00375,0x00375);
   (0x00384,0x00385);
   (0x01FBD,0x01FBD);
   (0x01FBF,0x01FC1);
@@ -2090,44 +3532,67 @@ let sk = [
   (0x01FED,0x01FEF);
   (0x01FFD,0x01FFE);
   (0x0309B,0x0309C);
+  (0x0A700,0x0A716);
+  (0x0A720,0x0A721);
+  (0x0A789,0x0A78A);
+  (0x0AB5B,0x0AB5B);
+  (0x0FBB2,0x0FBC1);
   (0x0FF3E,0x0FF3E);
   (0x0FF40,0x0FF40);
   (0x0FFE3,0x0FFE3)
 ]
 (* Symbol, Other  *)
 let so = [
-  (0x000A6,0x000A7);
+  (0x000A6,0x000A6);
   (0x000A9,0x000A9);
   (0x000AE,0x000AE);
   (0x000B0,0x000B0);
-  (0x000B6,0x000B6);
   (0x00482,0x00482);
+  (0x0058D,0x0058E);
+  (0x0060E,0x0060F);
+  (0x006DE,0x006DE);
   (0x006E9,0x006E9);
   (0x006FD,0x006FE);
+  (0x007F6,0x007F6);
   (0x009FA,0x009FA);
   (0x00B70,0x00B70);
+  (0x00BF3,0x00BF8);
+  (0x00BFA,0x00BFA);
+  (0x00C7F,0x00C7F);
+  (0x00D4F,0x00D4F);
+  (0x00D79,0x00D79);
   (0x00F01,0x00F03);
-  (0x00F13,0x00F17);
+  (0x00F13,0x00F13);
+  (0x00F15,0x00F17);
   (0x00F1A,0x00F1F);
   (0x00F34,0x00F34);
   (0x00F36,0x00F36);
   (0x00F38,0x00F38);
   (0x00FBE,0x00FC5);
   (0x00FC7,0x00FCC);
-  (0x00FCF,0x00FCF);
+  (0x00FCE,0x00FCF);
+  (0x00FD5,0x00FD8);
+  (0x0109E,0x0109F);
+  (0x01390,0x01399);
+  (0x01940,0x01940);
+  (0x019DE,0x019FF);
+  (0x01B61,0x01B6A);
+  (0x01B74,0x01B7C);
   (0x02100,0x02101);
   (0x02103,0x02106);
   (0x02108,0x02109);
   (0x02114,0x02114);
-  (0x02116,0x02118);
+  (0x02116,0x02117);
   (0x0211E,0x02123);
   (0x02125,0x02125);
   (0x02127,0x02127);
   (0x02129,0x02129);
   (0x0212E,0x0212E);
-  (0x02132,0x02132);
-  (0x0213A,0x0213A);
+  (0x0213A,0x0213B);
   (0x0214A,0x0214A);
+  (0x0214C,0x0214D);
+  (0x0214F,0x0214F);
+  (0x0218A,0x0218B);
   (0x02195,0x02199);
   (0x0219C,0x0219F);
   (0x021A1,0x021A2);
@@ -2142,31 +3607,27 @@ let so = [
   (0x02322,0x02328);
   (0x0232B,0x0237B);
   (0x0237D,0x0239A);
-  (0x023B7,0x023CE);
+  (0x023B4,0x023DB);
+  (0x023E2,0x023FE);
   (0x02400,0x02426);
   (0x02440,0x0244A);
   (0x0249C,0x024E9);
   (0x02500,0x025B6);
   (0x025B8,0x025C0);
   (0x025C2,0x025F7);
-  (0x02600,0x02613);
-  (0x02616,0x02617);
-  (0x02619,0x0266E);
-  (0x02670,0x0267D);
-  (0x02680,0x02689);
-  (0x02701,0x02704);
-  (0x02706,0x02709);
-  (0x0270C,0x02727);
-  (0x02729,0x0274B);
-  (0x0274D,0x0274D);
-  (0x0274F,0x02752);
-  (0x02756,0x02756);
-  (0x02758,0x0275E);
-  (0x02761,0x02767);
-  (0x02794,0x02794);
-  (0x02798,0x027AF);
-  (0x027B1,0x027BE);
+  (0x02600,0x0266E);
+  (0x02670,0x02767);
+  (0x02794,0x027BF);
   (0x02800,0x028FF);
+  (0x02B00,0x02B2F);
+  (0x02B45,0x02B46);
+  (0x02B4D,0x02B73);
+  (0x02B76,0x02B95);
+  (0x02B98,0x02BB9);
+  (0x02BBD,0x02BC8);
+  (0x02BCA,0x02BD1);
+  (0x02BEC,0x02BEF);
+  (0x02CE5,0x02CEA);
   (0x02E80,0x02E99);
   (0x02E9B,0x02EF3);
   (0x02F00,0x02FD5);
@@ -2178,31 +3639,84 @@ let so = [
   (0x0303E,0x0303F);
   (0x03190,0x03191);
   (0x03196,0x0319F);
-  (0x03200,0x0321C);
-  (0x0322A,0x03243);
-  (0x03260,0x0327B);
-  (0x0327F,0x0327F);
+  (0x031C0,0x031E3);
+  (0x03200,0x0321E);
+  (0x0322A,0x03247);
+  (0x03250,0x03250);
+  (0x03260,0x0327F);
   (0x0328A,0x032B0);
-  (0x032C0,0x032CB);
-  (0x032D0,0x032FE);
-  (0x03300,0x03376);
-  (0x0337B,0x033DD);
-  (0x033E0,0x033FE);
+  (0x032C0,0x032FE);
+  (0x03300,0x033FF);
+  (0x04DC0,0x04DFF);
   (0x0A490,0x0A4C6);
+  (0x0A828,0x0A82B);
+  (0x0A836,0x0A837);
+  (0x0A839,0x0A839);
+  (0x0AA77,0x0AA79);
+  (0x0FDFD,0x0FDFD);
   (0x0FFE4,0x0FFE4);
   (0x0FFE8,0x0FFE8);
   (0x0FFED,0x0FFEE);
   (0x0FFFC,0x0FFFD);
+  (0x10137,0x1013F);
+  (0x10179,0x10189);
+  (0x1018C,0x1018E);
+  (0x10190,0x1019B);
+  (0x101A0,0x101A0);
+  (0x101D0,0x101FC);
+  (0x10877,0x10878);
+  (0x10AC8,0x10AC8);
+  (0x1173F,0x1173F);
+  (0x16B3C,0x16B3F);
+  (0x16B45,0x16B45);
+  (0x1BC9C,0x1BC9C);
   (0x1D000,0x1D0F5);
   (0x1D100,0x1D126);
-  (0x1D12A,0x1D164);
+  (0x1D129,0x1D164);
   (0x1D16A,0x1D16C);
   (0x1D183,0x1D184);
   (0x1D18C,0x1D1A9);
-  (0x1D1AE,0x1D1DD)
+  (0x1D1AE,0x1D1E8);
+  (0x1D200,0x1D241);
+  (0x1D245,0x1D245);
+  (0x1D300,0x1D356);
+  (0x1D800,0x1D9FF);
+  (0x1DA37,0x1DA3A);
+  (0x1DA6D,0x1DA74);
+  (0x1DA76,0x1DA83);
+  (0x1DA85,0x1DA86);
+  (0x1F000,0x1F02B);
+  (0x1F030,0x1F093);
+  (0x1F0A0,0x1F0AE);
+  (0x1F0B1,0x1F0BF);
+  (0x1F0C1,0x1F0CF);
+  (0x1F0D1,0x1F0F5);
+  (0x1F110,0x1F12E);
+  (0x1F130,0x1F16B);
+  (0x1F170,0x1F1AC);
+  (0x1F1E6,0x1F202);
+  (0x1F210,0x1F23B);
+  (0x1F240,0x1F248);
+  (0x1F250,0x1F251);
+  (0x1F300,0x1F3FA);
+  (0x1F400,0x1F6D2);
+  (0x1F6E0,0x1F6EC);
+  (0x1F6F0,0x1F6F6);
+  (0x1F700,0x1F773);
+  (0x1F780,0x1F7D4);
+  (0x1F800,0x1F80B);
+  (0x1F810,0x1F847);
+  (0x1F850,0x1F859);
+  (0x1F860,0x1F887);
+  (0x1F890,0x1F8AD);
+  (0x1F910,0x1F91E);
+  (0x1F920,0x1F927);
+  (0x1F930,0x1F930);
+  (0x1F933,0x1F93E);
+  (0x1F940,0x1F94B);
+  (0x1F950,0x1F95E);
+  (0x1F980,0x1F991)
 ]
-
-(* Conversion to lower case. *)
 let to_lower = [
   (0x00041,0x0005A), `Delta (32);
   (0x000C0,0x000D6), `Delta (32);
@@ -2358,12 +3872,31 @@ let to_lower = [
   (0x0022E,0x0022E), `Abs (0x0022F);
   (0x00230,0x00230), `Abs (0x00231);
   (0x00232,0x00232), `Abs (0x00233);
+  (0x0023A,0x0023A), `Abs (0x02C65);
+  (0x0023B,0x0023B), `Abs (0x0023C);
+  (0x0023D,0x0023D), `Abs (0x0019A);
+  (0x0023E,0x0023E), `Abs (0x02C66);
+  (0x00241,0x00241), `Abs (0x00242);
+  (0x00243,0x00243), `Abs (0x00180);
+  (0x00244,0x00244), `Abs (0x00289);
+  (0x00245,0x00245), `Abs (0x0028C);
+  (0x00246,0x00246), `Abs (0x00247);
+  (0x00248,0x00248), `Abs (0x00249);
+  (0x0024A,0x0024A), `Abs (0x0024B);
+  (0x0024C,0x0024C), `Abs (0x0024D);
+  (0x0024E,0x0024E), `Abs (0x0024F);
+  (0x00370,0x00370), `Abs (0x00371);
+  (0x00372,0x00372), `Abs (0x00373);
+  (0x00376,0x00376), `Abs (0x00377);
+  (0x0037F,0x0037F), `Abs (0x003F3);
   (0x00386,0x00386), `Abs (0x003AC);
   (0x00388,0x0038A), `Delta (37);
   (0x0038C,0x0038C), `Abs (0x003CC);
   (0x0038E,0x0038F), `Delta (63);
   (0x00391,0x003A1), `Delta (32);
   (0x003A3,0x003AB), `Delta (32);
+  (0x003CF,0x003CF), `Abs (0x003D7);
+  (0x003D2,0x003D4), `Delta (0);
   (0x003D8,0x003D8), `Abs (0x003D9);
   (0x003DA,0x003DA), `Abs (0x003DB);
   (0x003DC,0x003DC), `Abs (0x003DD);
@@ -2377,6 +3910,10 @@ let to_lower = [
   (0x003EC,0x003EC), `Abs (0x003ED);
   (0x003EE,0x003EE), `Abs (0x003EF);
   (0x003F4,0x003F4), `Abs (0x003B8);
+  (0x003F7,0x003F7), `Abs (0x003F8);
+  (0x003F9,0x003F9), `Abs (0x003F2);
+  (0x003FA,0x003FA), `Abs (0x003FB);
+  (0x003FD,0x003FF), `Delta (-130);
   (0x00400,0x0040F), `Delta (80);
   (0x00410,0x0042F), `Delta (32);
   (0x00460,0x00460), `Abs (0x00461);
@@ -2423,6 +3960,7 @@ let to_lower = [
   (0x004BA,0x004BA), `Abs (0x004BB);
   (0x004BC,0x004BC), `Abs (0x004BD);
   (0x004BE,0x004BE), `Abs (0x004BF);
+  (0x004C0,0x004C0), `Abs (0x004CF);
   (0x004C1,0x004C1), `Abs (0x004C2);
   (0x004C3,0x004C3), `Abs (0x004C4);
   (0x004C5,0x004C5), `Abs (0x004C6);
@@ -2449,7 +3987,11 @@ let to_lower = [
   (0x004F0,0x004F0), `Abs (0x004F1);
   (0x004F2,0x004F2), `Abs (0x004F3);
   (0x004F4,0x004F4), `Abs (0x004F5);
+  (0x004F6,0x004F6), `Abs (0x004F7);
   (0x004F8,0x004F8), `Abs (0x004F9);
+  (0x004FA,0x004FA), `Abs (0x004FB);
+  (0x004FC,0x004FC), `Abs (0x004FD);
+  (0x004FE,0x004FE), `Abs (0x004FF);
   (0x00500,0x00500), `Abs (0x00501);
   (0x00502,0x00502), `Abs (0x00503);
   (0x00504,0x00504), `Abs (0x00505);
@@ -2458,7 +4000,28 @@ let to_lower = [
   (0x0050A,0x0050A), `Abs (0x0050B);
   (0x0050C,0x0050C), `Abs (0x0050D);
   (0x0050E,0x0050E), `Abs (0x0050F);
+  (0x00510,0x00510), `Abs (0x00511);
+  (0x00512,0x00512), `Abs (0x00513);
+  (0x00514,0x00514), `Abs (0x00515);
+  (0x00516,0x00516), `Abs (0x00517);
+  (0x00518,0x00518), `Abs (0x00519);
+  (0x0051A,0x0051A), `Abs (0x0051B);
+  (0x0051C,0x0051C), `Abs (0x0051D);
+  (0x0051E,0x0051E), `Abs (0x0051F);
+  (0x00520,0x00520), `Abs (0x00521);
+  (0x00522,0x00522), `Abs (0x00523);
+  (0x00524,0x00524), `Abs (0x00525);
+  (0x00526,0x00526), `Abs (0x00527);
+  (0x00528,0x00528), `Abs (0x00529);
+  (0x0052A,0x0052A), `Abs (0x0052B);
+  (0x0052C,0x0052C), `Abs (0x0052D);
+  (0x0052E,0x0052E), `Abs (0x0052F);
   (0x00531,0x00556), `Delta (48);
+  (0x010A0,0x010C5), `Delta (7264);
+  (0x010C7,0x010C7), `Abs (0x02D27);
+  (0x010CD,0x010CD), `Abs (0x02D2D);
+  (0x013A0,0x013EF), `Delta (38864);
+  (0x013F0,0x013F5), `Delta (8);
   (0x01E00,0x01E00), `Abs (0x01E01);
   (0x01E02,0x01E02), `Abs (0x01E03);
   (0x01E04,0x01E04), `Abs (0x01E05);
@@ -2534,6 +4097,7 @@ let to_lower = [
   (0x01E90,0x01E90), `Abs (0x01E91);
   (0x01E92,0x01E92), `Abs (0x01E93);
   (0x01E94,0x01E94), `Abs (0x01E95);
+  (0x01E9E,0x01E9E), `Abs (0x000DF);
   (0x01EA0,0x01EA0), `Abs (0x01EA1);
   (0x01EA2,0x01EA2), `Abs (0x01EA3);
   (0x01EA4,0x01EA4), `Abs (0x01EA5);
@@ -2579,6 +4143,9 @@ let to_lower = [
   (0x01EF4,0x01EF4), `Abs (0x01EF5);
   (0x01EF6,0x01EF6), `Abs (0x01EF7);
   (0x01EF8,0x01EF8), `Abs (0x01EF9);
+  (0x01EFA,0x01EFA), `Abs (0x01EFB);
+  (0x01EFC,0x01EFC), `Abs (0x01EFD);
+  (0x01EFE,0x01EFE), `Abs (0x01EFF);
   (0x01F08,0x01F0F), `Delta (-8);
   (0x01F18,0x01F1D), `Delta (-8);
   (0x01F28,0x01F2F), `Delta (-8);
@@ -2599,11 +4166,870 @@ let to_lower = [
   (0x01FEC,0x01FEC), `Abs (0x01FE5);
   (0x01FF8,0x01FF9), `Delta (-128);
   (0x01FFA,0x01FFB), `Delta (-126);
+  (0x02102,0x02102), `Abs (0x02102);
+  (0x02107,0x02107), `Abs (0x02107);
+  (0x0210B,0x0210D), `Delta (0);
+  (0x02110,0x02112), `Delta (0);
+  (0x02115,0x02115), `Abs (0x02115);
+  (0x02119,0x0211D), `Delta (0);
+  (0x02124,0x02124), `Abs (0x02124);
   (0x02126,0x02126), `Abs (0x003C9);
+  (0x02128,0x02128), `Abs (0x02128);
   (0x0212A,0x0212A), `Abs (0x0006B);
   (0x0212B,0x0212B), `Abs (0x000E5);
+  (0x0212C,0x0212D), `Delta (0);
+  (0x02130,0x02131), `Delta (0);
+  (0x02132,0x02132), `Abs (0x0214E);
+  (0x02133,0x02133), `Abs (0x02133);
+  (0x0213E,0x0213F), `Delta (0);
+  (0x02145,0x02145), `Abs (0x02145);
+  (0x02183,0x02183), `Abs (0x02184);
+  (0x02C00,0x02C2E), `Delta (48);
+  (0x02C60,0x02C60), `Abs (0x02C61);
+  (0x02C62,0x02C62), `Abs (0x0026B);
+  (0x02C63,0x02C63), `Abs (0x01D7D);
+  (0x02C64,0x02C64), `Abs (0x0027D);
+  (0x02C67,0x02C67), `Abs (0x02C68);
+  (0x02C69,0x02C69), `Abs (0x02C6A);
+  (0x02C6B,0x02C6B), `Abs (0x02C6C);
+  (0x02C6D,0x02C6D), `Abs (0x00251);
+  (0x02C6E,0x02C6E), `Abs (0x00271);
+  (0x02C6F,0x02C6F), `Abs (0x00250);
+  (0x02C70,0x02C70), `Abs (0x00252);
+  (0x02C72,0x02C72), `Abs (0x02C73);
+  (0x02C75,0x02C75), `Abs (0x02C76);
+  (0x02C7E,0x02C7F), `Delta (-10815);
+  (0x02C80,0x02C80), `Abs (0x02C81);
+  (0x02C82,0x02C82), `Abs (0x02C83);
+  (0x02C84,0x02C84), `Abs (0x02C85);
+  (0x02C86,0x02C86), `Abs (0x02C87);
+  (0x02C88,0x02C88), `Abs (0x02C89);
+  (0x02C8A,0x02C8A), `Abs (0x02C8B);
+  (0x02C8C,0x02C8C), `Abs (0x02C8D);
+  (0x02C8E,0x02C8E), `Abs (0x02C8F);
+  (0x02C90,0x02C90), `Abs (0x02C91);
+  (0x02C92,0x02C92), `Abs (0x02C93);
+  (0x02C94,0x02C94), `Abs (0x02C95);
+  (0x02C96,0x02C96), `Abs (0x02C97);
+  (0x02C98,0x02C98), `Abs (0x02C99);
+  (0x02C9A,0x02C9A), `Abs (0x02C9B);
+  (0x02C9C,0x02C9C), `Abs (0x02C9D);
+  (0x02C9E,0x02C9E), `Abs (0x02C9F);
+  (0x02CA0,0x02CA0), `Abs (0x02CA1);
+  (0x02CA2,0x02CA2), `Abs (0x02CA3);
+  (0x02CA4,0x02CA4), `Abs (0x02CA5);
+  (0x02CA6,0x02CA6), `Abs (0x02CA7);
+  (0x02CA8,0x02CA8), `Abs (0x02CA9);
+  (0x02CAA,0x02CAA), `Abs (0x02CAB);
+  (0x02CAC,0x02CAC), `Abs (0x02CAD);
+  (0x02CAE,0x02CAE), `Abs (0x02CAF);
+  (0x02CB0,0x02CB0), `Abs (0x02CB1);
+  (0x02CB2,0x02CB2), `Abs (0x02CB3);
+  (0x02CB4,0x02CB4), `Abs (0x02CB5);
+  (0x02CB6,0x02CB6), `Abs (0x02CB7);
+  (0x02CB8,0x02CB8), `Abs (0x02CB9);
+  (0x02CBA,0x02CBA), `Abs (0x02CBB);
+  (0x02CBC,0x02CBC), `Abs (0x02CBD);
+  (0x02CBE,0x02CBE), `Abs (0x02CBF);
+  (0x02CC0,0x02CC0), `Abs (0x02CC1);
+  (0x02CC2,0x02CC2), `Abs (0x02CC3);
+  (0x02CC4,0x02CC4), `Abs (0x02CC5);
+  (0x02CC6,0x02CC6), `Abs (0x02CC7);
+  (0x02CC8,0x02CC8), `Abs (0x02CC9);
+  (0x02CCA,0x02CCA), `Abs (0x02CCB);
+  (0x02CCC,0x02CCC), `Abs (0x02CCD);
+  (0x02CCE,0x02CCE), `Abs (0x02CCF);
+  (0x02CD0,0x02CD0), `Abs (0x02CD1);
+  (0x02CD2,0x02CD2), `Abs (0x02CD3);
+  (0x02CD4,0x02CD4), `Abs (0x02CD5);
+  (0x02CD6,0x02CD6), `Abs (0x02CD7);
+  (0x02CD8,0x02CD8), `Abs (0x02CD9);
+  (0x02CDA,0x02CDA), `Abs (0x02CDB);
+  (0x02CDC,0x02CDC), `Abs (0x02CDD);
+  (0x02CDE,0x02CDE), `Abs (0x02CDF);
+  (0x02CE0,0x02CE0), `Abs (0x02CE1);
+  (0x02CE2,0x02CE2), `Abs (0x02CE3);
+  (0x02CEB,0x02CEB), `Abs (0x02CEC);
+  (0x02CED,0x02CED), `Abs (0x02CEE);
+  (0x02CF2,0x02CF2), `Abs (0x02CF3);
+  (0x0A640,0x0A640), `Abs (0x0A641);
+  (0x0A642,0x0A642), `Abs (0x0A643);
+  (0x0A644,0x0A644), `Abs (0x0A645);
+  (0x0A646,0x0A646), `Abs (0x0A647);
+  (0x0A648,0x0A648), `Abs (0x0A649);
+  (0x0A64A,0x0A64A), `Abs (0x0A64B);
+  (0x0A64C,0x0A64C), `Abs (0x0A64D);
+  (0x0A64E,0x0A64E), `Abs (0x0A64F);
+  (0x0A650,0x0A650), `Abs (0x0A651);
+  (0x0A652,0x0A652), `Abs (0x0A653);
+  (0x0A654,0x0A654), `Abs (0x0A655);
+  (0x0A656,0x0A656), `Abs (0x0A657);
+  (0x0A658,0x0A658), `Abs (0x0A659);
+  (0x0A65A,0x0A65A), `Abs (0x0A65B);
+  (0x0A65C,0x0A65C), `Abs (0x0A65D);
+  (0x0A65E,0x0A65E), `Abs (0x0A65F);
+  (0x0A660,0x0A660), `Abs (0x0A661);
+  (0x0A662,0x0A662), `Abs (0x0A663);
+  (0x0A664,0x0A664), `Abs (0x0A665);
+  (0x0A666,0x0A666), `Abs (0x0A667);
+  (0x0A668,0x0A668), `Abs (0x0A669);
+  (0x0A66A,0x0A66A), `Abs (0x0A66B);
+  (0x0A66C,0x0A66C), `Abs (0x0A66D);
+  (0x0A680,0x0A680), `Abs (0x0A681);
+  (0x0A682,0x0A682), `Abs (0x0A683);
+  (0x0A684,0x0A684), `Abs (0x0A685);
+  (0x0A686,0x0A686), `Abs (0x0A687);
+  (0x0A688,0x0A688), `Abs (0x0A689);
+  (0x0A68A,0x0A68A), `Abs (0x0A68B);
+  (0x0A68C,0x0A68C), `Abs (0x0A68D);
+  (0x0A68E,0x0A68E), `Abs (0x0A68F);
+  (0x0A690,0x0A690), `Abs (0x0A691);
+  (0x0A692,0x0A692), `Abs (0x0A693);
+  (0x0A694,0x0A694), `Abs (0x0A695);
+  (0x0A696,0x0A696), `Abs (0x0A697);
+  (0x0A698,0x0A698), `Abs (0x0A699);
+  (0x0A69A,0x0A69A), `Abs (0x0A69B);
+  (0x0A722,0x0A722), `Abs (0x0A723);
+  (0x0A724,0x0A724), `Abs (0x0A725);
+  (0x0A726,0x0A726), `Abs (0x0A727);
+  (0x0A728,0x0A728), `Abs (0x0A729);
+  (0x0A72A,0x0A72A), `Abs (0x0A72B);
+  (0x0A72C,0x0A72C), `Abs (0x0A72D);
+  (0x0A72E,0x0A72E), `Abs (0x0A72F);
+  (0x0A732,0x0A732), `Abs (0x0A733);
+  (0x0A734,0x0A734), `Abs (0x0A735);
+  (0x0A736,0x0A736), `Abs (0x0A737);
+  (0x0A738,0x0A738), `Abs (0x0A739);
+  (0x0A73A,0x0A73A), `Abs (0x0A73B);
+  (0x0A73C,0x0A73C), `Abs (0x0A73D);
+  (0x0A73E,0x0A73E), `Abs (0x0A73F);
+  (0x0A740,0x0A740), `Abs (0x0A741);
+  (0x0A742,0x0A742), `Abs (0x0A743);
+  (0x0A744,0x0A744), `Abs (0x0A745);
+  (0x0A746,0x0A746), `Abs (0x0A747);
+  (0x0A748,0x0A748), `Abs (0x0A749);
+  (0x0A74A,0x0A74A), `Abs (0x0A74B);
+  (0x0A74C,0x0A74C), `Abs (0x0A74D);
+  (0x0A74E,0x0A74E), `Abs (0x0A74F);
+  (0x0A750,0x0A750), `Abs (0x0A751);
+  (0x0A752,0x0A752), `Abs (0x0A753);
+  (0x0A754,0x0A754), `Abs (0x0A755);
+  (0x0A756,0x0A756), `Abs (0x0A757);
+  (0x0A758,0x0A758), `Abs (0x0A759);
+  (0x0A75A,0x0A75A), `Abs (0x0A75B);
+  (0x0A75C,0x0A75C), `Abs (0x0A75D);
+  (0x0A75E,0x0A75E), `Abs (0x0A75F);
+  (0x0A760,0x0A760), `Abs (0x0A761);
+  (0x0A762,0x0A762), `Abs (0x0A763);
+  (0x0A764,0x0A764), `Abs (0x0A765);
+  (0x0A766,0x0A766), `Abs (0x0A767);
+  (0x0A768,0x0A768), `Abs (0x0A769);
+  (0x0A76A,0x0A76A), `Abs (0x0A76B);
+  (0x0A76C,0x0A76C), `Abs (0x0A76D);
+  (0x0A76E,0x0A76E), `Abs (0x0A76F);
+  (0x0A779,0x0A779), `Abs (0x0A77A);
+  (0x0A77B,0x0A77B), `Abs (0x0A77C);
+  (0x0A77D,0x0A77D), `Abs (0x01D79);
+  (0x0A77E,0x0A77E), `Abs (0x0A77F);
+  (0x0A780,0x0A780), `Abs (0x0A781);
+  (0x0A782,0x0A782), `Abs (0x0A783);
+  (0x0A784,0x0A784), `Abs (0x0A785);
+  (0x0A786,0x0A786), `Abs (0x0A787);
+  (0x0A78B,0x0A78B), `Abs (0x0A78C);
+  (0x0A78D,0x0A78D), `Abs (0x00265);
+  (0x0A790,0x0A790), `Abs (0x0A791);
+  (0x0A792,0x0A792), `Abs (0x0A793);
+  (0x0A796,0x0A796), `Abs (0x0A797);
+  (0x0A798,0x0A798), `Abs (0x0A799);
+  (0x0A79A,0x0A79A), `Abs (0x0A79B);
+  (0x0A79C,0x0A79C), `Abs (0x0A79D);
+  (0x0A79E,0x0A79E), `Abs (0x0A79F);
+  (0x0A7A0,0x0A7A0), `Abs (0x0A7A1);
+  (0x0A7A2,0x0A7A2), `Abs (0x0A7A3);
+  (0x0A7A4,0x0A7A4), `Abs (0x0A7A5);
+  (0x0A7A6,0x0A7A6), `Abs (0x0A7A7);
+  (0x0A7A8,0x0A7A8), `Abs (0x0A7A9);
+  (0x0A7AA,0x0A7AA), `Abs (0x00266);
+  (0x0A7AB,0x0A7AB), `Abs (0x0025C);
+  (0x0A7AC,0x0A7AC), `Abs (0x00261);
+  (0x0A7AD,0x0A7AD), `Abs (0x0026C);
+  (0x0A7AE,0x0A7AE), `Abs (0x0026A);
+  (0x0A7B0,0x0A7B0), `Abs (0x0029E);
+  (0x0A7B1,0x0A7B1), `Abs (0x00287);
+  (0x0A7B2,0x0A7B2), `Abs (0x0029D);
+  (0x0A7B3,0x0A7B3), `Abs (0x0AB53);
+  (0x0A7B4,0x0A7B4), `Abs (0x0A7B5);
+  (0x0A7B6,0x0A7B6), `Abs (0x0A7B7);
   (0x0FF21,0x0FF3A), `Delta (32);
-  (0x10400,0x10425), `Delta (40);
+  (0x10400,0x10427), `Delta (40);
+  (0x104B0,0x104D3), `Delta (40);
+  (0x10C80,0x10CB2), `Delta (64);
+  (0x118A0,0x118BF), `Delta (32);
+  (0x1D400,0x1D419), `Delta (0);
+  (0x1D434,0x1D44D), `Delta (0);
+  (0x1D468,0x1D481), `Delta (0);
+  (0x1D49C,0x1D49C), `Abs (0x1D49C);
+  (0x1D49E,0x1D49F), `Delta (0);
+  (0x1D4A2,0x1D4A2), `Abs (0x1D4A2);
+  (0x1D4A5,0x1D4A6), `Delta (0);
+  (0x1D4A9,0x1D4AC), `Delta (0);
+  (0x1D4AE,0x1D4B5), `Delta (0);
+  (0x1D4D0,0x1D4E9), `Delta (0);
+  (0x1D504,0x1D505), `Delta (0);
+  (0x1D507,0x1D50A), `Delta (0);
+  (0x1D50D,0x1D514), `Delta (0);
+  (0x1D516,0x1D51C), `Delta (0);
+  (0x1D538,0x1D539), `Delta (0);
+  (0x1D53B,0x1D53E), `Delta (0);
+  (0x1D540,0x1D544), `Delta (0);
+  (0x1D546,0x1D546), `Abs (0x1D546);
+  (0x1D54A,0x1D550), `Delta (0);
+  (0x1D56C,0x1D585), `Delta (0);
+  (0x1D5A0,0x1D5B9), `Delta (0);
+  (0x1D5D4,0x1D5ED), `Delta (0);
+  (0x1D608,0x1D621), `Delta (0);
+  (0x1D63C,0x1D655), `Delta (0);
+  (0x1D670,0x1D689), `Delta (0);
+  (0x1D6A8,0x1D6C0), `Delta (0);
+  (0x1D6E2,0x1D6FA), `Delta (0);
+  (0x1D71C,0x1D734), `Delta (0);
+  (0x1D756,0x1D76E), `Delta (0);
+  (0x1D790,0x1D7A8), `Delta (0);
+  (0x1D7CA,0x1D7CA), `Abs (0x1D7CA);
+  (0x1E900,0x1E921), `Delta (34);
+  (0x00061,0x0007A), `Delta (0);
+  (0x000B5,0x000B5), `Abs (0x000B5);
+  (0x000DF,0x000F6), `Delta (0);
+  (0x000F8,0x000FF), `Delta (0);
+  (0x00101,0x00101), `Abs (0x00101);
+  (0x00103,0x00103), `Abs (0x00103);
+  (0x00105,0x00105), `Abs (0x00105);
+  (0x00107,0x00107), `Abs (0x00107);
+  (0x00109,0x00109), `Abs (0x00109);
+  (0x0010B,0x0010B), `Abs (0x0010B);
+  (0x0010D,0x0010D), `Abs (0x0010D);
+  (0x0010F,0x0010F), `Abs (0x0010F);
+  (0x00111,0x00111), `Abs (0x00111);
+  (0x00113,0x00113), `Abs (0x00113);
+  (0x00115,0x00115), `Abs (0x00115);
+  (0x00117,0x00117), `Abs (0x00117);
+  (0x00119,0x00119), `Abs (0x00119);
+  (0x0011B,0x0011B), `Abs (0x0011B);
+  (0x0011D,0x0011D), `Abs (0x0011D);
+  (0x0011F,0x0011F), `Abs (0x0011F);
+  (0x00121,0x00121), `Abs (0x00121);
+  (0x00123,0x00123), `Abs (0x00123);
+  (0x00125,0x00125), `Abs (0x00125);
+  (0x00127,0x00127), `Abs (0x00127);
+  (0x00129,0x00129), `Abs (0x00129);
+  (0x0012B,0x0012B), `Abs (0x0012B);
+  (0x0012D,0x0012D), `Abs (0x0012D);
+  (0x0012F,0x0012F), `Abs (0x0012F);
+  (0x00131,0x00131), `Abs (0x00131);
+  (0x00133,0x00133), `Abs (0x00133);
+  (0x00135,0x00135), `Abs (0x00135);
+  (0x00137,0x00138), `Delta (0);
+  (0x0013A,0x0013A), `Abs (0x0013A);
+  (0x0013C,0x0013C), `Abs (0x0013C);
+  (0x0013E,0x0013E), `Abs (0x0013E);
+  (0x00140,0x00140), `Abs (0x00140);
+  (0x00142,0x00142), `Abs (0x00142);
+  (0x00144,0x00144), `Abs (0x00144);
+  (0x00146,0x00146), `Abs (0x00146);
+  (0x00148,0x00149), `Delta (0);
+  (0x0014B,0x0014B), `Abs (0x0014B);
+  (0x0014D,0x0014D), `Abs (0x0014D);
+  (0x0014F,0x0014F), `Abs (0x0014F);
+  (0x00151,0x00151), `Abs (0x00151);
+  (0x00153,0x00153), `Abs (0x00153);
+  (0x00155,0x00155), `Abs (0x00155);
+  (0x00157,0x00157), `Abs (0x00157);
+  (0x00159,0x00159), `Abs (0x00159);
+  (0x0015B,0x0015B), `Abs (0x0015B);
+  (0x0015D,0x0015D), `Abs (0x0015D);
+  (0x0015F,0x0015F), `Abs (0x0015F);
+  (0x00161,0x00161), `Abs (0x00161);
+  (0x00163,0x00163), `Abs (0x00163);
+  (0x00165,0x00165), `Abs (0x00165);
+  (0x00167,0x00167), `Abs (0x00167);
+  (0x00169,0x00169), `Abs (0x00169);
+  (0x0016B,0x0016B), `Abs (0x0016B);
+  (0x0016D,0x0016D), `Abs (0x0016D);
+  (0x0016F,0x0016F), `Abs (0x0016F);
+  (0x00171,0x00171), `Abs (0x00171);
+  (0x00173,0x00173), `Abs (0x00173);
+  (0x00175,0x00175), `Abs (0x00175);
+  (0x00177,0x00177), `Abs (0x00177);
+  (0x0017A,0x0017A), `Abs (0x0017A);
+  (0x0017C,0x0017C), `Abs (0x0017C);
+  (0x0017E,0x00180), `Delta (0);
+  (0x00183,0x00183), `Abs (0x00183);
+  (0x00185,0x00185), `Abs (0x00185);
+  (0x00188,0x00188), `Abs (0x00188);
+  (0x0018C,0x0018D), `Delta (0);
+  (0x00192,0x00192), `Abs (0x00192);
+  (0x00195,0x00195), `Abs (0x00195);
+  (0x00199,0x0019B), `Delta (0);
+  (0x0019E,0x0019E), `Abs (0x0019E);
+  (0x001A1,0x001A1), `Abs (0x001A1);
+  (0x001A3,0x001A3), `Abs (0x001A3);
+  (0x001A5,0x001A5), `Abs (0x001A5);
+  (0x001A8,0x001A8), `Abs (0x001A8);
+  (0x001AA,0x001AB), `Delta (0);
+  (0x001AD,0x001AD), `Abs (0x001AD);
+  (0x001B0,0x001B0), `Abs (0x001B0);
+  (0x001B4,0x001B4), `Abs (0x001B4);
+  (0x001B6,0x001B6), `Abs (0x001B6);
+  (0x001B9,0x001BA), `Delta (0);
+  (0x001BD,0x001BF), `Delta (0);
+  (0x001C6,0x001C6), `Abs (0x001C6);
+  (0x001C9,0x001C9), `Abs (0x001C9);
+  (0x001CC,0x001CC), `Abs (0x001CC);
+  (0x001CE,0x001CE), `Abs (0x001CE);
+  (0x001D0,0x001D0), `Abs (0x001D0);
+  (0x001D2,0x001D2), `Abs (0x001D2);
+  (0x001D4,0x001D4), `Abs (0x001D4);
+  (0x001D6,0x001D6), `Abs (0x001D6);
+  (0x001D8,0x001D8), `Abs (0x001D8);
+  (0x001DA,0x001DA), `Abs (0x001DA);
+  (0x001DC,0x001DD), `Delta (0);
+  (0x001DF,0x001DF), `Abs (0x001DF);
+  (0x001E1,0x001E1), `Abs (0x001E1);
+  (0x001E3,0x001E3), `Abs (0x001E3);
+  (0x001E5,0x001E5), `Abs (0x001E5);
+  (0x001E7,0x001E7), `Abs (0x001E7);
+  (0x001E9,0x001E9), `Abs (0x001E9);
+  (0x001EB,0x001EB), `Abs (0x001EB);
+  (0x001ED,0x001ED), `Abs (0x001ED);
+  (0x001EF,0x001F0), `Delta (0);
+  (0x001F3,0x001F3), `Abs (0x001F3);
+  (0x001F5,0x001F5), `Abs (0x001F5);
+  (0x001F9,0x001F9), `Abs (0x001F9);
+  (0x001FB,0x001FB), `Abs (0x001FB);
+  (0x001FD,0x001FD), `Abs (0x001FD);
+  (0x001FF,0x001FF), `Abs (0x001FF);
+  (0x00201,0x00201), `Abs (0x00201);
+  (0x00203,0x00203), `Abs (0x00203);
+  (0x00205,0x00205), `Abs (0x00205);
+  (0x00207,0x00207), `Abs (0x00207);
+  (0x00209,0x00209), `Abs (0x00209);
+  (0x0020B,0x0020B), `Abs (0x0020B);
+  (0x0020D,0x0020D), `Abs (0x0020D);
+  (0x0020F,0x0020F), `Abs (0x0020F);
+  (0x00211,0x00211), `Abs (0x00211);
+  (0x00213,0x00213), `Abs (0x00213);
+  (0x00215,0x00215), `Abs (0x00215);
+  (0x00217,0x00217), `Abs (0x00217);
+  (0x00219,0x00219), `Abs (0x00219);
+  (0x0021B,0x0021B), `Abs (0x0021B);
+  (0x0021D,0x0021D), `Abs (0x0021D);
+  (0x0021F,0x0021F), `Abs (0x0021F);
+  (0x00221,0x00221), `Abs (0x00221);
+  (0x00223,0x00223), `Abs (0x00223);
+  (0x00225,0x00225), `Abs (0x00225);
+  (0x00227,0x00227), `Abs (0x00227);
+  (0x00229,0x00229), `Abs (0x00229);
+  (0x0022B,0x0022B), `Abs (0x0022B);
+  (0x0022D,0x0022D), `Abs (0x0022D);
+  (0x0022F,0x0022F), `Abs (0x0022F);
+  (0x00231,0x00231), `Abs (0x00231);
+  (0x00233,0x00239), `Delta (0);
+  (0x0023C,0x0023C), `Abs (0x0023C);
+  (0x0023F,0x00240), `Delta (0);
+  (0x00242,0x00242), `Abs (0x00242);
+  (0x00247,0x00247), `Abs (0x00247);
+  (0x00249,0x00249), `Abs (0x00249);
+  (0x0024B,0x0024B), `Abs (0x0024B);
+  (0x0024D,0x0024D), `Abs (0x0024D);
+  (0x0024F,0x00293), `Delta (0);
+  (0x00295,0x002AF), `Delta (0);
+  (0x00371,0x00371), `Abs (0x00371);
+  (0x00373,0x00373), `Abs (0x00373);
+  (0x00377,0x00377), `Abs (0x00377);
+  (0x0037B,0x0037D), `Delta (0);
+  (0x00390,0x00390), `Abs (0x00390);
+  (0x003AC,0x003CE), `Delta (0);
+  (0x003D0,0x003D1), `Delta (0);
+  (0x003D5,0x003D7), `Delta (0);
+  (0x003D9,0x003D9), `Abs (0x003D9);
+  (0x003DB,0x003DB), `Abs (0x003DB);
+  (0x003DD,0x003DD), `Abs (0x003DD);
+  (0x003DF,0x003DF), `Abs (0x003DF);
+  (0x003E1,0x003E1), `Abs (0x003E1);
+  (0x003E3,0x003E3), `Abs (0x003E3);
+  (0x003E5,0x003E5), `Abs (0x003E5);
+  (0x003E7,0x003E7), `Abs (0x003E7);
+  (0x003E9,0x003E9), `Abs (0x003E9);
+  (0x003EB,0x003EB), `Abs (0x003EB);
+  (0x003ED,0x003ED), `Abs (0x003ED);
+  (0x003EF,0x003F3), `Delta (0);
+  (0x003F5,0x003F5), `Abs (0x003F5);
+  (0x003F8,0x003F8), `Abs (0x003F8);
+  (0x003FB,0x003FC), `Delta (0);
+  (0x00430,0x0045F), `Delta (0);
+  (0x00461,0x00461), `Abs (0x00461);
+  (0x00463,0x00463), `Abs (0x00463);
+  (0x00465,0x00465), `Abs (0x00465);
+  (0x00467,0x00467), `Abs (0x00467);
+  (0x00469,0x00469), `Abs (0x00469);
+  (0x0046B,0x0046B), `Abs (0x0046B);
+  (0x0046D,0x0046D), `Abs (0x0046D);
+  (0x0046F,0x0046F), `Abs (0x0046F);
+  (0x00471,0x00471), `Abs (0x00471);
+  (0x00473,0x00473), `Abs (0x00473);
+  (0x00475,0x00475), `Abs (0x00475);
+  (0x00477,0x00477), `Abs (0x00477);
+  (0x00479,0x00479), `Abs (0x00479);
+  (0x0047B,0x0047B), `Abs (0x0047B);
+  (0x0047D,0x0047D), `Abs (0x0047D);
+  (0x0047F,0x0047F), `Abs (0x0047F);
+  (0x00481,0x00481), `Abs (0x00481);
+  (0x0048B,0x0048B), `Abs (0x0048B);
+  (0x0048D,0x0048D), `Abs (0x0048D);
+  (0x0048F,0x0048F), `Abs (0x0048F);
+  (0x00491,0x00491), `Abs (0x00491);
+  (0x00493,0x00493), `Abs (0x00493);
+  (0x00495,0x00495), `Abs (0x00495);
+  (0x00497,0x00497), `Abs (0x00497);
+  (0x00499,0x00499), `Abs (0x00499);
+  (0x0049B,0x0049B), `Abs (0x0049B);
+  (0x0049D,0x0049D), `Abs (0x0049D);
+  (0x0049F,0x0049F), `Abs (0x0049F);
+  (0x004A1,0x004A1), `Abs (0x004A1);
+  (0x004A3,0x004A3), `Abs (0x004A3);
+  (0x004A5,0x004A5), `Abs (0x004A5);
+  (0x004A7,0x004A7), `Abs (0x004A7);
+  (0x004A9,0x004A9), `Abs (0x004A9);
+  (0x004AB,0x004AB), `Abs (0x004AB);
+  (0x004AD,0x004AD), `Abs (0x004AD);
+  (0x004AF,0x004AF), `Abs (0x004AF);
+  (0x004B1,0x004B1), `Abs (0x004B1);
+  (0x004B3,0x004B3), `Abs (0x004B3);
+  (0x004B5,0x004B5), `Abs (0x004B5);
+  (0x004B7,0x004B7), `Abs (0x004B7);
+  (0x004B9,0x004B9), `Abs (0x004B9);
+  (0x004BB,0x004BB), `Abs (0x004BB);
+  (0x004BD,0x004BD), `Abs (0x004BD);
+  (0x004BF,0x004BF), `Abs (0x004BF);
+  (0x004C2,0x004C2), `Abs (0x004C2);
+  (0x004C4,0x004C4), `Abs (0x004C4);
+  (0x004C6,0x004C6), `Abs (0x004C6);
+  (0x004C8,0x004C8), `Abs (0x004C8);
+  (0x004CA,0x004CA), `Abs (0x004CA);
+  (0x004CC,0x004CC), `Abs (0x004CC);
+  (0x004CE,0x004CF), `Delta (0);
+  (0x004D1,0x004D1), `Abs (0x004D1);
+  (0x004D3,0x004D3), `Abs (0x004D3);
+  (0x004D5,0x004D5), `Abs (0x004D5);
+  (0x004D7,0x004D7), `Abs (0x004D7);
+  (0x004D9,0x004D9), `Abs (0x004D9);
+  (0x004DB,0x004DB), `Abs (0x004DB);
+  (0x004DD,0x004DD), `Abs (0x004DD);
+  (0x004DF,0x004DF), `Abs (0x004DF);
+  (0x004E1,0x004E1), `Abs (0x004E1);
+  (0x004E3,0x004E3), `Abs (0x004E3);
+  (0x004E5,0x004E5), `Abs (0x004E5);
+  (0x004E7,0x004E7), `Abs (0x004E7);
+  (0x004E9,0x004E9), `Abs (0x004E9);
+  (0x004EB,0x004EB), `Abs (0x004EB);
+  (0x004ED,0x004ED), `Abs (0x004ED);
+  (0x004EF,0x004EF), `Abs (0x004EF);
+  (0x004F1,0x004F1), `Abs (0x004F1);
+  (0x004F3,0x004F3), `Abs (0x004F3);
+  (0x004F5,0x004F5), `Abs (0x004F5);
+  (0x004F7,0x004F7), `Abs (0x004F7);
+  (0x004F9,0x004F9), `Abs (0x004F9);
+  (0x004FB,0x004FB), `Abs (0x004FB);
+  (0x004FD,0x004FD), `Abs (0x004FD);
+  (0x004FF,0x004FF), `Abs (0x004FF);
+  (0x00501,0x00501), `Abs (0x00501);
+  (0x00503,0x00503), `Abs (0x00503);
+  (0x00505,0x00505), `Abs (0x00505);
+  (0x00507,0x00507), `Abs (0x00507);
+  (0x00509,0x00509), `Abs (0x00509);
+  (0x0050B,0x0050B), `Abs (0x0050B);
+  (0x0050D,0x0050D), `Abs (0x0050D);
+  (0x0050F,0x0050F), `Abs (0x0050F);
+  (0x00511,0x00511), `Abs (0x00511);
+  (0x00513,0x00513), `Abs (0x00513);
+  (0x00515,0x00515), `Abs (0x00515);
+  (0x00517,0x00517), `Abs (0x00517);
+  (0x00519,0x00519), `Abs (0x00519);
+  (0x0051B,0x0051B), `Abs (0x0051B);
+  (0x0051D,0x0051D), `Abs (0x0051D);
+  (0x0051F,0x0051F), `Abs (0x0051F);
+  (0x00521,0x00521), `Abs (0x00521);
+  (0x00523,0x00523), `Abs (0x00523);
+  (0x00525,0x00525), `Abs (0x00525);
+  (0x00527,0x00527), `Abs (0x00527);
+  (0x00529,0x00529), `Abs (0x00529);
+  (0x0052B,0x0052B), `Abs (0x0052B);
+  (0x0052D,0x0052D), `Abs (0x0052D);
+  (0x0052F,0x0052F), `Abs (0x0052F);
+  (0x00561,0x00587), `Delta (0);
+  (0x013F8,0x013FD), `Delta (0);
+  (0x01C80,0x01C88), `Delta (0);
+  (0x01D00,0x01D2B), `Delta (0);
+  (0x01D6B,0x01D77), `Delta (0);
+  (0x01D79,0x01D9A), `Delta (0);
+  (0x01E01,0x01E01), `Abs (0x01E01);
+  (0x01E03,0x01E03), `Abs (0x01E03);
+  (0x01E05,0x01E05), `Abs (0x01E05);
+  (0x01E07,0x01E07), `Abs (0x01E07);
+  (0x01E09,0x01E09), `Abs (0x01E09);
+  (0x01E0B,0x01E0B), `Abs (0x01E0B);
+  (0x01E0D,0x01E0D), `Abs (0x01E0D);
+  (0x01E0F,0x01E0F), `Abs (0x01E0F);
+  (0x01E11,0x01E11), `Abs (0x01E11);
+  (0x01E13,0x01E13), `Abs (0x01E13);
+  (0x01E15,0x01E15), `Abs (0x01E15);
+  (0x01E17,0x01E17), `Abs (0x01E17);
+  (0x01E19,0x01E19), `Abs (0x01E19);
+  (0x01E1B,0x01E1B), `Abs (0x01E1B);
+  (0x01E1D,0x01E1D), `Abs (0x01E1D);
+  (0x01E1F,0x01E1F), `Abs (0x01E1F);
+  (0x01E21,0x01E21), `Abs (0x01E21);
+  (0x01E23,0x01E23), `Abs (0x01E23);
+  (0x01E25,0x01E25), `Abs (0x01E25);
+  (0x01E27,0x01E27), `Abs (0x01E27);
+  (0x01E29,0x01E29), `Abs (0x01E29);
+  (0x01E2B,0x01E2B), `Abs (0x01E2B);
+  (0x01E2D,0x01E2D), `Abs (0x01E2D);
+  (0x01E2F,0x01E2F), `Abs (0x01E2F);
+  (0x01E31,0x01E31), `Abs (0x01E31);
+  (0x01E33,0x01E33), `Abs (0x01E33);
+  (0x01E35,0x01E35), `Abs (0x01E35);
+  (0x01E37,0x01E37), `Abs (0x01E37);
+  (0x01E39,0x01E39), `Abs (0x01E39);
+  (0x01E3B,0x01E3B), `Abs (0x01E3B);
+  (0x01E3D,0x01E3D), `Abs (0x01E3D);
+  (0x01E3F,0x01E3F), `Abs (0x01E3F);
+  (0x01E41,0x01E41), `Abs (0x01E41);
+  (0x01E43,0x01E43), `Abs (0x01E43);
+  (0x01E45,0x01E45), `Abs (0x01E45);
+  (0x01E47,0x01E47), `Abs (0x01E47);
+  (0x01E49,0x01E49), `Abs (0x01E49);
+  (0x01E4B,0x01E4B), `Abs (0x01E4B);
+  (0x01E4D,0x01E4D), `Abs (0x01E4D);
+  (0x01E4F,0x01E4F), `Abs (0x01E4F);
+  (0x01E51,0x01E51), `Abs (0x01E51);
+  (0x01E53,0x01E53), `Abs (0x01E53);
+  (0x01E55,0x01E55), `Abs (0x01E55);
+  (0x01E57,0x01E57), `Abs (0x01E57);
+  (0x01E59,0x01E59), `Abs (0x01E59);
+  (0x01E5B,0x01E5B), `Abs (0x01E5B);
+  (0x01E5D,0x01E5D), `Abs (0x01E5D);
+  (0x01E5F,0x01E5F), `Abs (0x01E5F);
+  (0x01E61,0x01E61), `Abs (0x01E61);
+  (0x01E63,0x01E63), `Abs (0x01E63);
+  (0x01E65,0x01E65), `Abs (0x01E65);
+  (0x01E67,0x01E67), `Abs (0x01E67);
+  (0x01E69,0x01E69), `Abs (0x01E69);
+  (0x01E6B,0x01E6B), `Abs (0x01E6B);
+  (0x01E6D,0x01E6D), `Abs (0x01E6D);
+  (0x01E6F,0x01E6F), `Abs (0x01E6F);
+  (0x01E71,0x01E71), `Abs (0x01E71);
+  (0x01E73,0x01E73), `Abs (0x01E73);
+  (0x01E75,0x01E75), `Abs (0x01E75);
+  (0x01E77,0x01E77), `Abs (0x01E77);
+  (0x01E79,0x01E79), `Abs (0x01E79);
+  (0x01E7B,0x01E7B), `Abs (0x01E7B);
+  (0x01E7D,0x01E7D), `Abs (0x01E7D);
+  (0x01E7F,0x01E7F), `Abs (0x01E7F);
+  (0x01E81,0x01E81), `Abs (0x01E81);
+  (0x01E83,0x01E83), `Abs (0x01E83);
+  (0x01E85,0x01E85), `Abs (0x01E85);
+  (0x01E87,0x01E87), `Abs (0x01E87);
+  (0x01E89,0x01E89), `Abs (0x01E89);
+  (0x01E8B,0x01E8B), `Abs (0x01E8B);
+  (0x01E8D,0x01E8D), `Abs (0x01E8D);
+  (0x01E8F,0x01E8F), `Abs (0x01E8F);
+  (0x01E91,0x01E91), `Abs (0x01E91);
+  (0x01E93,0x01E93), `Abs (0x01E93);
+  (0x01E95,0x01E9D), `Delta (0);
+  (0x01E9F,0x01E9F), `Abs (0x01E9F);
+  (0x01EA1,0x01EA1), `Abs (0x01EA1);
+  (0x01EA3,0x01EA3), `Abs (0x01EA3);
+  (0x01EA5,0x01EA5), `Abs (0x01EA5);
+  (0x01EA7,0x01EA7), `Abs (0x01EA7);
+  (0x01EA9,0x01EA9), `Abs (0x01EA9);
+  (0x01EAB,0x01EAB), `Abs (0x01EAB);
+  (0x01EAD,0x01EAD), `Abs (0x01EAD);
+  (0x01EAF,0x01EAF), `Abs (0x01EAF);
+  (0x01EB1,0x01EB1), `Abs (0x01EB1);
+  (0x01EB3,0x01EB3), `Abs (0x01EB3);
+  (0x01EB5,0x01EB5), `Abs (0x01EB5);
+  (0x01EB7,0x01EB7), `Abs (0x01EB7);
+  (0x01EB9,0x01EB9), `Abs (0x01EB9);
+  (0x01EBB,0x01EBB), `Abs (0x01EBB);
+  (0x01EBD,0x01EBD), `Abs (0x01EBD);
+  (0x01EBF,0x01EBF), `Abs (0x01EBF);
+  (0x01EC1,0x01EC1), `Abs (0x01EC1);
+  (0x01EC3,0x01EC3), `Abs (0x01EC3);
+  (0x01EC5,0x01EC5), `Abs (0x01EC5);
+  (0x01EC7,0x01EC7), `Abs (0x01EC7);
+  (0x01EC9,0x01EC9), `Abs (0x01EC9);
+  (0x01ECB,0x01ECB), `Abs (0x01ECB);
+  (0x01ECD,0x01ECD), `Abs (0x01ECD);
+  (0x01ECF,0x01ECF), `Abs (0x01ECF);
+  (0x01ED1,0x01ED1), `Abs (0x01ED1);
+  (0x01ED3,0x01ED3), `Abs (0x01ED3);
+  (0x01ED5,0x01ED5), `Abs (0x01ED5);
+  (0x01ED7,0x01ED7), `Abs (0x01ED7);
+  (0x01ED9,0x01ED9), `Abs (0x01ED9);
+  (0x01EDB,0x01EDB), `Abs (0x01EDB);
+  (0x01EDD,0x01EDD), `Abs (0x01EDD);
+  (0x01EDF,0x01EDF), `Abs (0x01EDF);
+  (0x01EE1,0x01EE1), `Abs (0x01EE1);
+  (0x01EE3,0x01EE3), `Abs (0x01EE3);
+  (0x01EE5,0x01EE5), `Abs (0x01EE5);
+  (0x01EE7,0x01EE7), `Abs (0x01EE7);
+  (0x01EE9,0x01EE9), `Abs (0x01EE9);
+  (0x01EEB,0x01EEB), `Abs (0x01EEB);
+  (0x01EED,0x01EED), `Abs (0x01EED);
+  (0x01EEF,0x01EEF), `Abs (0x01EEF);
+  (0x01EF1,0x01EF1), `Abs (0x01EF1);
+  (0x01EF3,0x01EF3), `Abs (0x01EF3);
+  (0x01EF5,0x01EF5), `Abs (0x01EF5);
+  (0x01EF7,0x01EF7), `Abs (0x01EF7);
+  (0x01EF9,0x01EF9), `Abs (0x01EF9);
+  (0x01EFB,0x01EFB), `Abs (0x01EFB);
+  (0x01EFD,0x01EFD), `Abs (0x01EFD);
+  (0x01EFF,0x01F07), `Delta (0);
+  (0x01F10,0x01F15), `Delta (0);
+  (0x01F20,0x01F27), `Delta (0);
+  (0x01F30,0x01F37), `Delta (0);
+  (0x01F40,0x01F45), `Delta (0);
+  (0x01F50,0x01F57), `Delta (0);
+  (0x01F60,0x01F67), `Delta (0);
+  (0x01F70,0x01F7D), `Delta (0);
+  (0x01F80,0x01F87), `Delta (0);
+  (0x01F90,0x01F97), `Delta (0);
+  (0x01FA0,0x01FA7), `Delta (0);
+  (0x01FB0,0x01FB4), `Delta (0);
+  (0x01FB6,0x01FB7), `Delta (0);
+  (0x01FBE,0x01FBE), `Abs (0x01FBE);
+  (0x01FC2,0x01FC4), `Delta (0);
+  (0x01FC6,0x01FC7), `Delta (0);
+  (0x01FD0,0x01FD3), `Delta (0);
+  (0x01FD6,0x01FD7), `Delta (0);
+  (0x01FE0,0x01FE7), `Delta (0);
+  (0x01FF2,0x01FF4), `Delta (0);
+  (0x01FF6,0x01FF7), `Delta (0);
+  (0x0210A,0x0210A), `Abs (0x0210A);
+  (0x0210E,0x0210F), `Delta (0);
+  (0x02113,0x02113), `Abs (0x02113);
+  (0x0212F,0x0212F), `Abs (0x0212F);
+  (0x02134,0x02134), `Abs (0x02134);
+  (0x02139,0x02139), `Abs (0x02139);
+  (0x0213C,0x0213D), `Delta (0);
+  (0x02146,0x02149), `Delta (0);
+  (0x0214E,0x0214E), `Abs (0x0214E);
+  (0x02184,0x02184), `Abs (0x02184);
+  (0x02C30,0x02C5E), `Delta (0);
+  (0x02C61,0x02C61), `Abs (0x02C61);
+  (0x02C65,0x02C66), `Delta (0);
+  (0x02C68,0x02C68), `Abs (0x02C68);
+  (0x02C6A,0x02C6A), `Abs (0x02C6A);
+  (0x02C6C,0x02C6C), `Abs (0x02C6C);
+  (0x02C71,0x02C71), `Abs (0x02C71);
+  (0x02C73,0x02C74), `Delta (0);
+  (0x02C76,0x02C7B), `Delta (0);
+  (0x02C81,0x02C81), `Abs (0x02C81);
+  (0x02C83,0x02C83), `Abs (0x02C83);
+  (0x02C85,0x02C85), `Abs (0x02C85);
+  (0x02C87,0x02C87), `Abs (0x02C87);
+  (0x02C89,0x02C89), `Abs (0x02C89);
+  (0x02C8B,0x02C8B), `Abs (0x02C8B);
+  (0x02C8D,0x02C8D), `Abs (0x02C8D);
+  (0x02C8F,0x02C8F), `Abs (0x02C8F);
+  (0x02C91,0x02C91), `Abs (0x02C91);
+  (0x02C93,0x02C93), `Abs (0x02C93);
+  (0x02C95,0x02C95), `Abs (0x02C95);
+  (0x02C97,0x02C97), `Abs (0x02C97);
+  (0x02C99,0x02C99), `Abs (0x02C99);
+  (0x02C9B,0x02C9B), `Abs (0x02C9B);
+  (0x02C9D,0x02C9D), `Abs (0x02C9D);
+  (0x02C9F,0x02C9F), `Abs (0x02C9F);
+  (0x02CA1,0x02CA1), `Abs (0x02CA1);
+  (0x02CA3,0x02CA3), `Abs (0x02CA3);
+  (0x02CA5,0x02CA5), `Abs (0x02CA5);
+  (0x02CA7,0x02CA7), `Abs (0x02CA7);
+  (0x02CA9,0x02CA9), `Abs (0x02CA9);
+  (0x02CAB,0x02CAB), `Abs (0x02CAB);
+  (0x02CAD,0x02CAD), `Abs (0x02CAD);
+  (0x02CAF,0x02CAF), `Abs (0x02CAF);
+  (0x02CB1,0x02CB1), `Abs (0x02CB1);
+  (0x02CB3,0x02CB3), `Abs (0x02CB3);
+  (0x02CB5,0x02CB5), `Abs (0x02CB5);
+  (0x02CB7,0x02CB7), `Abs (0x02CB7);
+  (0x02CB9,0x02CB9), `Abs (0x02CB9);
+  (0x02CBB,0x02CBB), `Abs (0x02CBB);
+  (0x02CBD,0x02CBD), `Abs (0x02CBD);
+  (0x02CBF,0x02CBF), `Abs (0x02CBF);
+  (0x02CC1,0x02CC1), `Abs (0x02CC1);
+  (0x02CC3,0x02CC3), `Abs (0x02CC3);
+  (0x02CC5,0x02CC5), `Abs (0x02CC5);
+  (0x02CC7,0x02CC7), `Abs (0x02CC7);
+  (0x02CC9,0x02CC9), `Abs (0x02CC9);
+  (0x02CCB,0x02CCB), `Abs (0x02CCB);
+  (0x02CCD,0x02CCD), `Abs (0x02CCD);
+  (0x02CCF,0x02CCF), `Abs (0x02CCF);
+  (0x02CD1,0x02CD1), `Abs (0x02CD1);
+  (0x02CD3,0x02CD3), `Abs (0x02CD3);
+  (0x02CD5,0x02CD5), `Abs (0x02CD5);
+  (0x02CD7,0x02CD7), `Abs (0x02CD7);
+  (0x02CD9,0x02CD9), `Abs (0x02CD9);
+  (0x02CDB,0x02CDB), `Abs (0x02CDB);
+  (0x02CDD,0x02CDD), `Abs (0x02CDD);
+  (0x02CDF,0x02CDF), `Abs (0x02CDF);
+  (0x02CE1,0x02CE1), `Abs (0x02CE1);
+  (0x02CE3,0x02CE4), `Delta (0);
+  (0x02CEC,0x02CEC), `Abs (0x02CEC);
+  (0x02CEE,0x02CEE), `Abs (0x02CEE);
+  (0x02CF3,0x02CF3), `Abs (0x02CF3);
+  (0x02D00,0x02D25), `Delta (0);
+  (0x02D27,0x02D27), `Abs (0x02D27);
+  (0x02D2D,0x02D2D), `Abs (0x02D2D);
+  (0x0A641,0x0A641), `Abs (0x0A641);
+  (0x0A643,0x0A643), `Abs (0x0A643);
+  (0x0A645,0x0A645), `Abs (0x0A645);
+  (0x0A647,0x0A647), `Abs (0x0A647);
+  (0x0A649,0x0A649), `Abs (0x0A649);
+  (0x0A64B,0x0A64B), `Abs (0x0A64B);
+  (0x0A64D,0x0A64D), `Abs (0x0A64D);
+  (0x0A64F,0x0A64F), `Abs (0x0A64F);
+  (0x0A651,0x0A651), `Abs (0x0A651);
+  (0x0A653,0x0A653), `Abs (0x0A653);
+  (0x0A655,0x0A655), `Abs (0x0A655);
+  (0x0A657,0x0A657), `Abs (0x0A657);
+  (0x0A659,0x0A659), `Abs (0x0A659);
+  (0x0A65B,0x0A65B), `Abs (0x0A65B);
+  (0x0A65D,0x0A65D), `Abs (0x0A65D);
+  (0x0A65F,0x0A65F), `Abs (0x0A65F);
+  (0x0A661,0x0A661), `Abs (0x0A661);
+  (0x0A663,0x0A663), `Abs (0x0A663);
+  (0x0A665,0x0A665), `Abs (0x0A665);
+  (0x0A667,0x0A667), `Abs (0x0A667);
+  (0x0A669,0x0A669), `Abs (0x0A669);
+  (0x0A66B,0x0A66B), `Abs (0x0A66B);
+  (0x0A66D,0x0A66D), `Abs (0x0A66D);
+  (0x0A681,0x0A681), `Abs (0x0A681);
+  (0x0A683,0x0A683), `Abs (0x0A683);
+  (0x0A685,0x0A685), `Abs (0x0A685);
+  (0x0A687,0x0A687), `Abs (0x0A687);
+  (0x0A689,0x0A689), `Abs (0x0A689);
+  (0x0A68B,0x0A68B), `Abs (0x0A68B);
+  (0x0A68D,0x0A68D), `Abs (0x0A68D);
+  (0x0A68F,0x0A68F), `Abs (0x0A68F);
+  (0x0A691,0x0A691), `Abs (0x0A691);
+  (0x0A693,0x0A693), `Abs (0x0A693);
+  (0x0A695,0x0A695), `Abs (0x0A695);
+  (0x0A697,0x0A697), `Abs (0x0A697);
+  (0x0A699,0x0A699), `Abs (0x0A699);
+  (0x0A69B,0x0A69B), `Abs (0x0A69B);
+  (0x0A723,0x0A723), `Abs (0x0A723);
+  (0x0A725,0x0A725), `Abs (0x0A725);
+  (0x0A727,0x0A727), `Abs (0x0A727);
+  (0x0A729,0x0A729), `Abs (0x0A729);
+  (0x0A72B,0x0A72B), `Abs (0x0A72B);
+  (0x0A72D,0x0A72D), `Abs (0x0A72D);
+  (0x0A72F,0x0A731), `Delta (0);
+  (0x0A733,0x0A733), `Abs (0x0A733);
+  (0x0A735,0x0A735), `Abs (0x0A735);
+  (0x0A737,0x0A737), `Abs (0x0A737);
+  (0x0A739,0x0A739), `Abs (0x0A739);
+  (0x0A73B,0x0A73B), `Abs (0x0A73B);
+  (0x0A73D,0x0A73D), `Abs (0x0A73D);
+  (0x0A73F,0x0A73F), `Abs (0x0A73F);
+  (0x0A741,0x0A741), `Abs (0x0A741);
+  (0x0A743,0x0A743), `Abs (0x0A743);
+  (0x0A745,0x0A745), `Abs (0x0A745);
+  (0x0A747,0x0A747), `Abs (0x0A747);
+  (0x0A749,0x0A749), `Abs (0x0A749);
+  (0x0A74B,0x0A74B), `Abs (0x0A74B);
+  (0x0A74D,0x0A74D), `Abs (0x0A74D);
+  (0x0A74F,0x0A74F), `Abs (0x0A74F);
+  (0x0A751,0x0A751), `Abs (0x0A751);
+  (0x0A753,0x0A753), `Abs (0x0A753);
+  (0x0A755,0x0A755), `Abs (0x0A755);
+  (0x0A757,0x0A757), `Abs (0x0A757);
+  (0x0A759,0x0A759), `Abs (0x0A759);
+  (0x0A75B,0x0A75B), `Abs (0x0A75B);
+  (0x0A75D,0x0A75D), `Abs (0x0A75D);
+  (0x0A75F,0x0A75F), `Abs (0x0A75F);
+  (0x0A761,0x0A761), `Abs (0x0A761);
+  (0x0A763,0x0A763), `Abs (0x0A763);
+  (0x0A765,0x0A765), `Abs (0x0A765);
+  (0x0A767,0x0A767), `Abs (0x0A767);
+  (0x0A769,0x0A769), `Abs (0x0A769);
+  (0x0A76B,0x0A76B), `Abs (0x0A76B);
+  (0x0A76D,0x0A76D), `Abs (0x0A76D);
+  (0x0A76F,0x0A76F), `Abs (0x0A76F);
+  (0x0A771,0x0A778), `Delta (0);
+  (0x0A77A,0x0A77A), `Abs (0x0A77A);
+  (0x0A77C,0x0A77C), `Abs (0x0A77C);
+  (0x0A77F,0x0A77F), `Abs (0x0A77F);
+  (0x0A781,0x0A781), `Abs (0x0A781);
+  (0x0A783,0x0A783), `Abs (0x0A783);
+  (0x0A785,0x0A785), `Abs (0x0A785);
+  (0x0A787,0x0A787), `Abs (0x0A787);
+  (0x0A78C,0x0A78C), `Abs (0x0A78C);
+  (0x0A78E,0x0A78E), `Abs (0x0A78E);
+  (0x0A791,0x0A791), `Abs (0x0A791);
+  (0x0A793,0x0A795), `Delta (0);
+  (0x0A797,0x0A797), `Abs (0x0A797);
+  (0x0A799,0x0A799), `Abs (0x0A799);
+  (0x0A79B,0x0A79B), `Abs (0x0A79B);
+  (0x0A79D,0x0A79D), `Abs (0x0A79D);
+  (0x0A79F,0x0A79F), `Abs (0x0A79F);
+  (0x0A7A1,0x0A7A1), `Abs (0x0A7A1);
+  (0x0A7A3,0x0A7A3), `Abs (0x0A7A3);
+  (0x0A7A5,0x0A7A5), `Abs (0x0A7A5);
+  (0x0A7A7,0x0A7A7), `Abs (0x0A7A7);
+  (0x0A7A9,0x0A7A9), `Abs (0x0A7A9);
+  (0x0A7B5,0x0A7B5), `Abs (0x0A7B5);
+  (0x0A7B7,0x0A7B7), `Abs (0x0A7B7);
+  (0x0A7FA,0x0A7FA), `Abs (0x0A7FA);
+  (0x0AB30,0x0AB5A), `Delta (0);
+  (0x0AB60,0x0AB65), `Delta (0);
+  (0x0AB70,0x0ABBF), `Delta (0);
+  (0x0FB00,0x0FB06), `Delta (0);
+  (0x0FB13,0x0FB17), `Delta (0);
+  (0x0FF41,0x0FF5A), `Delta (0);
+  (0x10428,0x1044F), `Delta (0);
+  (0x104D8,0x104FB), `Delta (0);
+  (0x10CC0,0x10CF2), `Delta (0);
+  (0x118C0,0x118DF), `Delta (0);
+  (0x1D41A,0x1D433), `Delta (0);
+  (0x1D44E,0x1D454), `Delta (0);
+  (0x1D456,0x1D467), `Delta (0);
+  (0x1D482,0x1D49B), `Delta (0);
+  (0x1D4B6,0x1D4B9), `Delta (0);
+  (0x1D4BB,0x1D4BB), `Abs (0x1D4BB);
+  (0x1D4BD,0x1D4C3), `Delta (0);
+  (0x1D4C5,0x1D4CF), `Delta (0);
+  (0x1D4EA,0x1D503), `Delta (0);
+  (0x1D51E,0x1D537), `Delta (0);
+  (0x1D552,0x1D56B), `Delta (0);
+  (0x1D586,0x1D59F), `Delta (0);
+  (0x1D5BA,0x1D5D3), `Delta (0);
+  (0x1D5EE,0x1D607), `Delta (0);
+  (0x1D622,0x1D63B), `Delta (0);
+  (0x1D656,0x1D66F), `Delta (0);
+  (0x1D68A,0x1D6A5), `Delta (0);
+  (0x1D6C2,0x1D6DA), `Delta (0);
+  (0x1D6DC,0x1D6E1), `Delta (0);
+  (0x1D6FC,0x1D714), `Delta (0);
+  (0x1D716,0x1D71B), `Delta (0);
+  (0x1D736,0x1D74E), `Delta (0);
+  (0x1D750,0x1D755), `Delta (0);
+  (0x1D770,0x1D788), `Delta (0);
+  (0x1D78A,0x1D78F), `Delta (0);
+  (0x1D7AA,0x1D7C2), `Delta (0);
+  (0x1D7C4,0x1D7C9), `Delta (0);
+  (0x1D7CB,0x1D7CB), `Abs (0x1D7CB);
+  (0x1E922,0x1E943), `Delta (0);
   (0x001C5,0x001C5), `Abs (0x001C6);
   (0x001C8,0x001C8), `Abs (0x001C9);
   (0x001CB,0x001CB), `Abs (0x001CC);
@@ -2614,6 +5040,2388 @@ let to_lower = [
   (0x01FBC,0x01FBC), `Abs (0x01FB3);
   (0x01FCC,0x01FCC), `Abs (0x01FC3);
   (0x01FFC,0x01FFC), `Abs (0x01FF3);
-  (0x02160,0x0216F), `Delta (16)
-]
-
+  (0x00300,0x0036F), `Delta (0);
+  (0x00483,0x00487), `Delta (0);
+  (0x00591,0x005BD), `Delta (0);
+  (0x005BF,0x005BF), `Abs (0x005BF);
+  (0x005C1,0x005C2), `Delta (0);
+  (0x005C4,0x005C5), `Delta (0);
+  (0x005C7,0x005C7), `Abs (0x005C7);
+  (0x00610,0x0061A), `Delta (0);
+  (0x0064B,0x0065F), `Delta (0);
+  (0x00670,0x00670), `Abs (0x00670);
+  (0x006D6,0x006DC), `Delta (0);
+  (0x006DF,0x006E4), `Delta (0);
+  (0x006E7,0x006E8), `Delta (0);
+  (0x006EA,0x006ED), `Delta (0);
+  (0x00711,0x00711), `Abs (0x00711);
+  (0x00730,0x0074A), `Delta (0);
+  (0x007A6,0x007B0), `Delta (0);
+  (0x007EB,0x007F3), `Delta (0);
+  (0x00816,0x00819), `Delta (0);
+  (0x0081B,0x00823), `Delta (0);
+  (0x00825,0x00827), `Delta (0);
+  (0x00829,0x0082D), `Delta (0);
+  (0x00859,0x0085B), `Delta (0);
+  (0x008D4,0x008E1), `Delta (0);
+  (0x008E3,0x00902), `Delta (0);
+  (0x0093A,0x0093A), `Abs (0x0093A);
+  (0x0093C,0x0093C), `Abs (0x0093C);
+  (0x00941,0x00948), `Delta (0);
+  (0x0094D,0x0094D), `Abs (0x0094D);
+  (0x00951,0x00957), `Delta (0);
+  (0x00962,0x00963), `Delta (0);
+  (0x00981,0x00981), `Abs (0x00981);
+  (0x009BC,0x009BC), `Abs (0x009BC);
+  (0x009C1,0x009C4), `Delta (0);
+  (0x009CD,0x009CD), `Abs (0x009CD);
+  (0x009E2,0x009E3), `Delta (0);
+  (0x00A01,0x00A02), `Delta (0);
+  (0x00A3C,0x00A3C), `Abs (0x00A3C);
+  (0x00A41,0x00A42), `Delta (0);
+  (0x00A47,0x00A48), `Delta (0);
+  (0x00A4B,0x00A4D), `Delta (0);
+  (0x00A51,0x00A51), `Abs (0x00A51);
+  (0x00A70,0x00A71), `Delta (0);
+  (0x00A75,0x00A75), `Abs (0x00A75);
+  (0x00A81,0x00A82), `Delta (0);
+  (0x00ABC,0x00ABC), `Abs (0x00ABC);
+  (0x00AC1,0x00AC5), `Delta (0);
+  (0x00AC7,0x00AC8), `Delta (0);
+  (0x00ACD,0x00ACD), `Abs (0x00ACD);
+  (0x00AE2,0x00AE3), `Delta (0);
+  (0x00B01,0x00B01), `Abs (0x00B01);
+  (0x00B3C,0x00B3C), `Abs (0x00B3C);
+  (0x00B3F,0x00B3F), `Abs (0x00B3F);
+  (0x00B41,0x00B44), `Delta (0);
+  (0x00B4D,0x00B4D), `Abs (0x00B4D);
+  (0x00B56,0x00B56), `Abs (0x00B56);
+  (0x00B62,0x00B63), `Delta (0);
+  (0x00B82,0x00B82), `Abs (0x00B82);
+  (0x00BC0,0x00BC0), `Abs (0x00BC0);
+  (0x00BCD,0x00BCD), `Abs (0x00BCD);
+  (0x00C00,0x00C00), `Abs (0x00C00);
+  (0x00C3E,0x00C40), `Delta (0);
+  (0x00C46,0x00C48), `Delta (0);
+  (0x00C4A,0x00C4D), `Delta (0);
+  (0x00C55,0x00C56), `Delta (0);
+  (0x00C62,0x00C63), `Delta (0);
+  (0x00C81,0x00C81), `Abs (0x00C81);
+  (0x00CBC,0x00CBC), `Abs (0x00CBC);
+  (0x00CBF,0x00CBF), `Abs (0x00CBF);
+  (0x00CC6,0x00CC6), `Abs (0x00CC6);
+  (0x00CCC,0x00CCD), `Delta (0);
+  (0x00CE2,0x00CE3), `Delta (0);
+  (0x00D01,0x00D01), `Abs (0x00D01);
+  (0x00D41,0x00D44), `Delta (0);
+  (0x00D4D,0x00D4D), `Abs (0x00D4D);
+  (0x00D62,0x00D63), `Delta (0);
+  (0x00DCA,0x00DCA), `Abs (0x00DCA);
+  (0x00DD2,0x00DD4), `Delta (0);
+  (0x00DD6,0x00DD6), `Abs (0x00DD6);
+  (0x00E31,0x00E31), `Abs (0x00E31);
+  (0x00E34,0x00E3A), `Delta (0);
+  (0x00E47,0x00E4E), `Delta (0);
+  (0x00EB1,0x00EB1), `Abs (0x00EB1);
+  (0x00EB4,0x00EB9), `Delta (0);
+  (0x00EBB,0x00EBC), `Delta (0);
+  (0x00EC8,0x00ECD), `Delta (0);
+  (0x00F18,0x00F19), `Delta (0);
+  (0x00F35,0x00F35), `Abs (0x00F35);
+  (0x00F37,0x00F37), `Abs (0x00F37);
+  (0x00F39,0x00F39), `Abs (0x00F39);
+  (0x00F71,0x00F7E), `Delta (0);
+  (0x00F80,0x00F84), `Delta (0);
+  (0x00F86,0x00F87), `Delta (0);
+  (0x00F8D,0x00F97), `Delta (0);
+  (0x00F99,0x00FBC), `Delta (0);
+  (0x00FC6,0x00FC6), `Abs (0x00FC6);
+  (0x0102D,0x01030), `Delta (0);
+  (0x01032,0x01037), `Delta (0);
+  (0x01039,0x0103A), `Delta (0);
+  (0x0103D,0x0103E), `Delta (0);
+  (0x01058,0x01059), `Delta (0);
+  (0x0105E,0x01060), `Delta (0);
+  (0x01071,0x01074), `Delta (0);
+  (0x01082,0x01082), `Abs (0x01082);
+  (0x01085,0x01086), `Delta (0);
+  (0x0108D,0x0108D), `Abs (0x0108D);
+  (0x0109D,0x0109D), `Abs (0x0109D);
+  (0x0135D,0x0135F), `Delta (0);
+  (0x01712,0x01714), `Delta (0);
+  (0x01732,0x01734), `Delta (0);
+  (0x01752,0x01753), `Delta (0);
+  (0x01772,0x01773), `Delta (0);
+  (0x017B4,0x017B5), `Delta (0);
+  (0x017B7,0x017BD), `Delta (0);
+  (0x017C6,0x017C6), `Abs (0x017C6);
+  (0x017C9,0x017D3), `Delta (0);
+  (0x017DD,0x017DD), `Abs (0x017DD);
+  (0x0180B,0x0180D), `Delta (0);
+  (0x01885,0x01886), `Delta (0);
+  (0x018A9,0x018A9), `Abs (0x018A9);
+  (0x01920,0x01922), `Delta (0);
+  (0x01927,0x01928), `Delta (0);
+  (0x01932,0x01932), `Abs (0x01932);
+  (0x01939,0x0193B), `Delta (0);
+  (0x01A17,0x01A18), `Delta (0);
+  (0x01A1B,0x01A1B), `Abs (0x01A1B);
+  (0x01A56,0x01A56), `Abs (0x01A56);
+  (0x01A58,0x01A5E), `Delta (0);
+  (0x01A60,0x01A60), `Abs (0x01A60);
+  (0x01A62,0x01A62), `Abs (0x01A62);
+  (0x01A65,0x01A6C), `Delta (0);
+  (0x01A73,0x01A7C), `Delta (0);
+  (0x01A7F,0x01A7F), `Abs (0x01A7F);
+  (0x01AB0,0x01ABD), `Delta (0);
+  (0x01B00,0x01B03), `Delta (0);
+  (0x01B34,0x01B34), `Abs (0x01B34);
+  (0x01B36,0x01B3A), `Delta (0);
+  (0x01B3C,0x01B3C), `Abs (0x01B3C);
+  (0x01B42,0x01B42), `Abs (0x01B42);
+  (0x01B6B,0x01B73), `Delta (0);
+  (0x01B80,0x01B81), `Delta (0);
+  (0x01BA2,0x01BA5), `Delta (0);
+  (0x01BA8,0x01BA9), `Delta (0);
+  (0x01BAB,0x01BAD), `Delta (0);
+  (0x01BE6,0x01BE6), `Abs (0x01BE6);
+  (0x01BE8,0x01BE9), `Delta (0);
+  (0x01BED,0x01BED), `Abs (0x01BED);
+  (0x01BEF,0x01BF1), `Delta (0);
+  (0x01C2C,0x01C33), `Delta (0);
+  (0x01C36,0x01C37), `Delta (0);
+  (0x01CD0,0x01CD2), `Delta (0);
+  (0x01CD4,0x01CE0), `Delta (0);
+  (0x01CE2,0x01CE8), `Delta (0);
+  (0x01CED,0x01CED), `Abs (0x01CED);
+  (0x01CF4,0x01CF4), `Abs (0x01CF4);
+  (0x01CF8,0x01CF9), `Delta (0);
+  (0x01DC0,0x01DF5), `Delta (0);
+  (0x01DFB,0x01DFF), `Delta (0);
+  (0x020D0,0x020DC), `Delta (0);
+  (0x020E1,0x020E1), `Abs (0x020E1);
+  (0x020E5,0x020F0), `Delta (0);
+  (0x02CEF,0x02CF1), `Delta (0);
+  (0x02D7F,0x02D7F), `Abs (0x02D7F);
+  (0x02DE0,0x02DFF), `Delta (0);
+  (0x0302A,0x0302D), `Delta (0);
+  (0x03099,0x0309A), `Delta (0);
+  (0x0A66F,0x0A66F), `Abs (0x0A66F);
+  (0x0A674,0x0A67D), `Delta (0);
+  (0x0A69E,0x0A69F), `Delta (0);
+  (0x0A6F0,0x0A6F1), `Delta (0);
+  (0x0A802,0x0A802), `Abs (0x0A802);
+  (0x0A806,0x0A806), `Abs (0x0A806);
+  (0x0A80B,0x0A80B), `Abs (0x0A80B);
+  (0x0A825,0x0A826), `Delta (0);
+  (0x0A8C4,0x0A8C5), `Delta (0);
+  (0x0A8E0,0x0A8F1), `Delta (0);
+  (0x0A926,0x0A92D), `Delta (0);
+  (0x0A947,0x0A951), `Delta (0);
+  (0x0A980,0x0A982), `Delta (0);
+  (0x0A9B3,0x0A9B3), `Abs (0x0A9B3);
+  (0x0A9B6,0x0A9B9), `Delta (0);
+  (0x0A9BC,0x0A9BC), `Abs (0x0A9BC);
+  (0x0A9E5,0x0A9E5), `Abs (0x0A9E5);
+  (0x0AA29,0x0AA2E), `Delta (0);
+  (0x0AA31,0x0AA32), `Delta (0);
+  (0x0AA35,0x0AA36), `Delta (0);
+  (0x0AA43,0x0AA43), `Abs (0x0AA43);
+  (0x0AA4C,0x0AA4C), `Abs (0x0AA4C);
+  (0x0AA7C,0x0AA7C), `Abs (0x0AA7C);
+  (0x0AAB0,0x0AAB0), `Abs (0x0AAB0);
+  (0x0AAB2,0x0AAB4), `Delta (0);
+  (0x0AAB7,0x0AAB8), `Delta (0);
+  (0x0AABE,0x0AABF), `Delta (0);
+  (0x0AAC1,0x0AAC1), `Abs (0x0AAC1);
+  (0x0AAEC,0x0AAED), `Delta (0);
+  (0x0AAF6,0x0AAF6), `Abs (0x0AAF6);
+  (0x0ABE5,0x0ABE5), `Abs (0x0ABE5);
+  (0x0ABE8,0x0ABE8), `Abs (0x0ABE8);
+  (0x0ABED,0x0ABED), `Abs (0x0ABED);
+  (0x0FB1E,0x0FB1E), `Abs (0x0FB1E);
+  (0x0FE00,0x0FE0F), `Delta (0);
+  (0x0FE20,0x0FE2F), `Delta (0);
+  (0x101FD,0x101FD), `Abs (0x101FD);
+  (0x102E0,0x102E0), `Abs (0x102E0);
+  (0x10376,0x1037A), `Delta (0);
+  (0x10A01,0x10A03), `Delta (0);
+  (0x10A05,0x10A06), `Delta (0);
+  (0x10A0C,0x10A0F), `Delta (0);
+  (0x10A38,0x10A3A), `Delta (0);
+  (0x10A3F,0x10A3F), `Abs (0x10A3F);
+  (0x10AE5,0x10AE6), `Delta (0);
+  (0x11001,0x11001), `Abs (0x11001);
+  (0x11038,0x11046), `Delta (0);
+  (0x1107F,0x11081), `Delta (0);
+  (0x110B3,0x110B6), `Delta (0);
+  (0x110B9,0x110BA), `Delta (0);
+  (0x11100,0x11102), `Delta (0);
+  (0x11127,0x1112B), `Delta (0);
+  (0x1112D,0x11134), `Delta (0);
+  (0x11173,0x11173), `Abs (0x11173);
+  (0x11180,0x11181), `Delta (0);
+  (0x111B6,0x111BE), `Delta (0);
+  (0x111CA,0x111CC), `Delta (0);
+  (0x1122F,0x11231), `Delta (0);
+  (0x11234,0x11234), `Abs (0x11234);
+  (0x11236,0x11237), `Delta (0);
+  (0x1123E,0x1123E), `Abs (0x1123E);
+  (0x112DF,0x112DF), `Abs (0x112DF);
+  (0x112E3,0x112EA), `Delta (0);
+  (0x11300,0x11301), `Delta (0);
+  (0x1133C,0x1133C), `Abs (0x1133C);
+  (0x11340,0x11340), `Abs (0x11340);
+  (0x11366,0x1136C), `Delta (0);
+  (0x11370,0x11374), `Delta (0);
+  (0x11438,0x1143F), `Delta (0);
+  (0x11442,0x11444), `Delta (0);
+  (0x11446,0x11446), `Abs (0x11446);
+  (0x114B3,0x114B8), `Delta (0);
+  (0x114BA,0x114BA), `Abs (0x114BA);
+  (0x114BF,0x114C0), `Delta (0);
+  (0x114C2,0x114C3), `Delta (0);
+  (0x115B2,0x115B5), `Delta (0);
+  (0x115BC,0x115BD), `Delta (0);
+  (0x115BF,0x115C0), `Delta (0);
+  (0x115DC,0x115DD), `Delta (0);
+  (0x11633,0x1163A), `Delta (0);
+  (0x1163D,0x1163D), `Abs (0x1163D);
+  (0x1163F,0x11640), `Delta (0);
+  (0x116AB,0x116AB), `Abs (0x116AB);
+  (0x116AD,0x116AD), `Abs (0x116AD);
+  (0x116B0,0x116B5), `Delta (0);
+  (0x116B7,0x116B7), `Abs (0x116B7);
+  (0x1171D,0x1171F), `Delta (0);
+  (0x11722,0x11725), `Delta (0);
+  (0x11727,0x1172B), `Delta (0);
+  (0x11C30,0x11C36), `Delta (0);
+  (0x11C38,0x11C3D), `Delta (0);
+  (0x11C3F,0x11C3F), `Abs (0x11C3F);
+  (0x11C92,0x11CA7), `Delta (0);
+  (0x11CAA,0x11CB0), `Delta (0);
+  (0x11CB2,0x11CB3), `Delta (0);
+  (0x11CB5,0x11CB6), `Delta (0);
+  (0x16AF0,0x16AF4), `Delta (0);
+  (0x16B30,0x16B36), `Delta (0);
+  (0x16F8F,0x16F92), `Delta (0);
+  (0x1BC9D,0x1BC9E), `Delta (0);
+  (0x1D167,0x1D169), `Delta (0);
+  (0x1D17B,0x1D182), `Delta (0);
+  (0x1D185,0x1D18B), `Delta (0);
+  (0x1D1AA,0x1D1AD), `Delta (0);
+  (0x1D242,0x1D244), `Delta (0);
+  (0x1DA00,0x1DA36), `Delta (0);
+  (0x1DA3B,0x1DA6C), `Delta (0);
+  (0x1DA75,0x1DA75), `Abs (0x1DA75);
+  (0x1DA84,0x1DA84), `Abs (0x1DA84);
+  (0x1DA9B,0x1DA9F), `Delta (0);
+  (0x1DAA1,0x1DAAF), `Delta (0);
+  (0x1E000,0x1E006), `Delta (0);
+  (0x1E008,0x1E018), `Delta (0);
+  (0x1E01B,0x1E021), `Delta (0);
+  (0x1E023,0x1E024), `Delta (0);
+  (0x1E026,0x1E02A), `Delta (0);
+  (0x1E8D0,0x1E8D6), `Delta (0);
+  (0x1E944,0x1E94A), `Delta (0);
+  (0xE0100,0xE01EF), `Delta (0);
+  (0x00903,0x00903), `Abs (0x00903);
+  (0x0093B,0x0093B), `Abs (0x0093B);
+  (0x0093E,0x00940), `Delta (0);
+  (0x00949,0x0094C), `Delta (0);
+  (0x0094E,0x0094F), `Delta (0);
+  (0x00982,0x00983), `Delta (0);
+  (0x009BE,0x009C0), `Delta (0);
+  (0x009C7,0x009C8), `Delta (0);
+  (0x009CB,0x009CC), `Delta (0);
+  (0x009D7,0x009D7), `Abs (0x009D7);
+  (0x00A03,0x00A03), `Abs (0x00A03);
+  (0x00A3E,0x00A40), `Delta (0);
+  (0x00A83,0x00A83), `Abs (0x00A83);
+  (0x00ABE,0x00AC0), `Delta (0);
+  (0x00AC9,0x00AC9), `Abs (0x00AC9);
+  (0x00ACB,0x00ACC), `Delta (0);
+  (0x00B02,0x00B03), `Delta (0);
+  (0x00B3E,0x00B3E), `Abs (0x00B3E);
+  (0x00B40,0x00B40), `Abs (0x00B40);
+  (0x00B47,0x00B48), `Delta (0);
+  (0x00B4B,0x00B4C), `Delta (0);
+  (0x00B57,0x00B57), `Abs (0x00B57);
+  (0x00BBE,0x00BBF), `Delta (0);
+  (0x00BC1,0x00BC2), `Delta (0);
+  (0x00BC6,0x00BC8), `Delta (0);
+  (0x00BCA,0x00BCC), `Delta (0);
+  (0x00BD7,0x00BD7), `Abs (0x00BD7);
+  (0x00C01,0x00C03), `Delta (0);
+  (0x00C41,0x00C44), `Delta (0);
+  (0x00C82,0x00C83), `Delta (0);
+  (0x00CBE,0x00CBE), `Abs (0x00CBE);
+  (0x00CC0,0x00CC4), `Delta (0);
+  (0x00CC7,0x00CC8), `Delta (0);
+  (0x00CCA,0x00CCB), `Delta (0);
+  (0x00CD5,0x00CD6), `Delta (0);
+  (0x00D02,0x00D03), `Delta (0);
+  (0x00D3E,0x00D40), `Delta (0);
+  (0x00D46,0x00D48), `Delta (0);
+  (0x00D4A,0x00D4C), `Delta (0);
+  (0x00D57,0x00D57), `Abs (0x00D57);
+  (0x00D82,0x00D83), `Delta (0);
+  (0x00DCF,0x00DD1), `Delta (0);
+  (0x00DD8,0x00DDF), `Delta (0);
+  (0x00DF2,0x00DF3), `Delta (0);
+  (0x00F3E,0x00F3F), `Delta (0);
+  (0x00F7F,0x00F7F), `Abs (0x00F7F);
+  (0x0102B,0x0102C), `Delta (0);
+  (0x01031,0x01031), `Abs (0x01031);
+  (0x01038,0x01038), `Abs (0x01038);
+  (0x0103B,0x0103C), `Delta (0);
+  (0x01056,0x01057), `Delta (0);
+  (0x01062,0x01064), `Delta (0);
+  (0x01067,0x0106D), `Delta (0);
+  (0x01083,0x01084), `Delta (0);
+  (0x01087,0x0108C), `Delta (0);
+  (0x0108F,0x0108F), `Abs (0x0108F);
+  (0x0109A,0x0109C), `Delta (0);
+  (0x017B6,0x017B6), `Abs (0x017B6);
+  (0x017BE,0x017C5), `Delta (0);
+  (0x017C7,0x017C8), `Delta (0);
+  (0x01923,0x01926), `Delta (0);
+  (0x01929,0x0192B), `Delta (0);
+  (0x01930,0x01931), `Delta (0);
+  (0x01933,0x01938), `Delta (0);
+  (0x01A19,0x01A1A), `Delta (0);
+  (0x01A55,0x01A55), `Abs (0x01A55);
+  (0x01A57,0x01A57), `Abs (0x01A57);
+  (0x01A61,0x01A61), `Abs (0x01A61);
+  (0x01A63,0x01A64), `Delta (0);
+  (0x01A6D,0x01A72), `Delta (0);
+  (0x01B04,0x01B04), `Abs (0x01B04);
+  (0x01B35,0x01B35), `Abs (0x01B35);
+  (0x01B3B,0x01B3B), `Abs (0x01B3B);
+  (0x01B3D,0x01B41), `Delta (0);
+  (0x01B43,0x01B44), `Delta (0);
+  (0x01B82,0x01B82), `Abs (0x01B82);
+  (0x01BA1,0x01BA1), `Abs (0x01BA1);
+  (0x01BA6,0x01BA7), `Delta (0);
+  (0x01BAA,0x01BAA), `Abs (0x01BAA);
+  (0x01BE7,0x01BE7), `Abs (0x01BE7);
+  (0x01BEA,0x01BEC), `Delta (0);
+  (0x01BEE,0x01BEE), `Abs (0x01BEE);
+  (0x01BF2,0x01BF3), `Delta (0);
+  (0x01C24,0x01C2B), `Delta (0);
+  (0x01C34,0x01C35), `Delta (0);
+  (0x01CE1,0x01CE1), `Abs (0x01CE1);
+  (0x01CF2,0x01CF3), `Delta (0);
+  (0x0302E,0x0302F), `Delta (0);
+  (0x0A823,0x0A824), `Delta (0);
+  (0x0A827,0x0A827), `Abs (0x0A827);
+  (0x0A880,0x0A881), `Delta (0);
+  (0x0A8B4,0x0A8C3), `Delta (0);
+  (0x0A952,0x0A953), `Delta (0);
+  (0x0A983,0x0A983), `Abs (0x0A983);
+  (0x0A9B4,0x0A9B5), `Delta (0);
+  (0x0A9BA,0x0A9BB), `Delta (0);
+  (0x0A9BD,0x0A9C0), `Delta (0);
+  (0x0AA2F,0x0AA30), `Delta (0);
+  (0x0AA33,0x0AA34), `Delta (0);
+  (0x0AA4D,0x0AA4D), `Abs (0x0AA4D);
+  (0x0AA7B,0x0AA7B), `Abs (0x0AA7B);
+  (0x0AA7D,0x0AA7D), `Abs (0x0AA7D);
+  (0x0AAEB,0x0AAEB), `Abs (0x0AAEB);
+  (0x0AAEE,0x0AAEF), `Delta (0);
+  (0x0AAF5,0x0AAF5), `Abs (0x0AAF5);
+  (0x0ABE3,0x0ABE4), `Delta (0);
+  (0x0ABE6,0x0ABE7), `Delta (0);
+  (0x0ABE9,0x0ABEA), `Delta (0);
+  (0x0ABEC,0x0ABEC), `Abs (0x0ABEC);
+  (0x11000,0x11000), `Abs (0x11000);
+  (0x11002,0x11002), `Abs (0x11002);
+  (0x11082,0x11082), `Abs (0x11082);
+  (0x110B0,0x110B2), `Delta (0);
+  (0x110B7,0x110B8), `Delta (0);
+  (0x1112C,0x1112C), `Abs (0x1112C);
+  (0x11182,0x11182), `Abs (0x11182);
+  (0x111B3,0x111B5), `Delta (0);
+  (0x111BF,0x111C0), `Delta (0);
+  (0x1122C,0x1122E), `Delta (0);
+  (0x11232,0x11233), `Delta (0);
+  (0x11235,0x11235), `Abs (0x11235);
+  (0x112E0,0x112E2), `Delta (0);
+  (0x11302,0x11303), `Delta (0);
+  (0x1133E,0x1133F), `Delta (0);
+  (0x11341,0x11344), `Delta (0);
+  (0x11347,0x11348), `Delta (0);
+  (0x1134B,0x1134D), `Delta (0);
+  (0x11357,0x11357), `Abs (0x11357);
+  (0x11362,0x11363), `Delta (0);
+  (0x11435,0x11437), `Delta (0);
+  (0x11440,0x11441), `Delta (0);
+  (0x11445,0x11445), `Abs (0x11445);
+  (0x114B0,0x114B2), `Delta (0);
+  (0x114B9,0x114B9), `Abs (0x114B9);
+  (0x114BB,0x114BE), `Delta (0);
+  (0x114C1,0x114C1), `Abs (0x114C1);
+  (0x115AF,0x115B1), `Delta (0);
+  (0x115B8,0x115BB), `Delta (0);
+  (0x115BE,0x115BE), `Abs (0x115BE);
+  (0x11630,0x11632), `Delta (0);
+  (0x1163B,0x1163C), `Delta (0);
+  (0x1163E,0x1163E), `Abs (0x1163E);
+  (0x116AC,0x116AC), `Abs (0x116AC);
+  (0x116AE,0x116AF), `Delta (0);
+  (0x116B6,0x116B6), `Abs (0x116B6);
+  (0x11720,0x11721), `Delta (0);
+  (0x11726,0x11726), `Abs (0x11726);
+  (0x11C2F,0x11C2F), `Abs (0x11C2F);
+  (0x11C3E,0x11C3E), `Abs (0x11C3E);
+  (0x11CA9,0x11CA9), `Abs (0x11CA9);
+  (0x11CB1,0x11CB1), `Abs (0x11CB1);
+  (0x11CB4,0x11CB4), `Abs (0x11CB4);
+  (0x16F51,0x16F7E), `Delta (0);
+  (0x1D165,0x1D166), `Delta (0);
+  (0x1D16D,0x1D172), `Delta (0);
+  (0x00488,0x00489), `Delta (0);
+  (0x01ABE,0x01ABE), `Abs (0x01ABE);
+  (0x020DD,0x020E0), `Delta (0);
+  (0x020E2,0x020E4), `Delta (0);
+  (0x0A670,0x0A672), `Delta (0);
+  (0x00030,0x00039), `Delta (0);
+  (0x00660,0x00669), `Delta (0);
+  (0x006F0,0x006F9), `Delta (0);
+  (0x007C0,0x007C9), `Delta (0);
+  (0x00966,0x0096F), `Delta (0);
+  (0x009E6,0x009EF), `Delta (0);
+  (0x00A66,0x00A6F), `Delta (0);
+  (0x00AE6,0x00AEF), `Delta (0);
+  (0x00B66,0x00B6F), `Delta (0);
+  (0x00BE6,0x00BEF), `Delta (0);
+  (0x00C66,0x00C6F), `Delta (0);
+  (0x00CE6,0x00CEF), `Delta (0);
+  (0x00D66,0x00D6F), `Delta (0);
+  (0x00DE6,0x00DEF), `Delta (0);
+  (0x00E50,0x00E59), `Delta (0);
+  (0x00ED0,0x00ED9), `Delta (0);
+  (0x00F20,0x00F29), `Delta (0);
+  (0x01040,0x01049), `Delta (0);
+  (0x01090,0x01099), `Delta (0);
+  (0x017E0,0x017E9), `Delta (0);
+  (0x01810,0x01819), `Delta (0);
+  (0x01946,0x0194F), `Delta (0);
+  (0x019D0,0x019D9), `Delta (0);
+  (0x01A80,0x01A89), `Delta (0);
+  (0x01A90,0x01A99), `Delta (0);
+  (0x01B50,0x01B59), `Delta (0);
+  (0x01BB0,0x01BB9), `Delta (0);
+  (0x01C40,0x01C49), `Delta (0);
+  (0x01C50,0x01C59), `Delta (0);
+  (0x0A620,0x0A629), `Delta (0);
+  (0x0A8D0,0x0A8D9), `Delta (0);
+  (0x0A900,0x0A909), `Delta (0);
+  (0x0A9D0,0x0A9D9), `Delta (0);
+  (0x0A9F0,0x0A9F9), `Delta (0);
+  (0x0AA50,0x0AA59), `Delta (0);
+  (0x0ABF0,0x0ABF9), `Delta (0);
+  (0x0FF10,0x0FF19), `Delta (0);
+  (0x104A0,0x104A9), `Delta (0);
+  (0x11066,0x1106F), `Delta (0);
+  (0x110F0,0x110F9), `Delta (0);
+  (0x11136,0x1113F), `Delta (0);
+  (0x111D0,0x111D9), `Delta (0);
+  (0x112F0,0x112F9), `Delta (0);
+  (0x11450,0x11459), `Delta (0);
+  (0x114D0,0x114D9), `Delta (0);
+  (0x11650,0x11659), `Delta (0);
+  (0x116C0,0x116C9), `Delta (0);
+  (0x11730,0x11739), `Delta (0);
+  (0x118E0,0x118E9), `Delta (0);
+  (0x11C50,0x11C59), `Delta (0);
+  (0x16A60,0x16A69), `Delta (0);
+  (0x16B50,0x16B59), `Delta (0);
+  (0x1D7CE,0x1D7FF), `Delta (0);
+  (0x1E950,0x1E959), `Delta (0);
+  (0x016EE,0x016F0), `Delta (0);
+  (0x02160,0x0216F), `Delta (16);
+  (0x02170,0x02182), `Delta (0);
+  (0x02185,0x02188), `Delta (0);
+  (0x03007,0x03007), `Abs (0x03007);
+  (0x03021,0x03029), `Delta (0);
+  (0x03038,0x0303A), `Delta (0);
+  (0x0A6E6,0x0A6EF), `Delta (0);
+  (0x10140,0x10174), `Delta (0);
+  (0x10341,0x10341), `Abs (0x10341);
+  (0x1034A,0x1034A), `Abs (0x1034A);
+  (0x103D1,0x103D5), `Delta (0);
+  (0x12400,0x1246E), `Delta (0);
+  (0x000B2,0x000B3), `Delta (0);
+  (0x000B9,0x000B9), `Abs (0x000B9);
+  (0x000BC,0x000BE), `Delta (0);
+  (0x009F4,0x009F9), `Delta (0);
+  (0x00B72,0x00B77), `Delta (0);
+  (0x00BF0,0x00BF2), `Delta (0);
+  (0x00C78,0x00C7E), `Delta (0);
+  (0x00D58,0x00D5E), `Delta (0);
+  (0x00D70,0x00D78), `Delta (0);
+  (0x00F2A,0x00F33), `Delta (0);
+  (0x01369,0x0137C), `Delta (0);
+  (0x017F0,0x017F9), `Delta (0);
+  (0x019DA,0x019DA), `Abs (0x019DA);
+  (0x02070,0x02070), `Abs (0x02070);
+  (0x02074,0x02079), `Delta (0);
+  (0x02080,0x02089), `Delta (0);
+  (0x02150,0x0215F), `Delta (0);
+  (0x02189,0x02189), `Abs (0x02189);
+  (0x02460,0x0249B), `Delta (0);
+  (0x024EA,0x024FF), `Delta (0);
+  (0x02776,0x02793), `Delta (0);
+  (0x02CFD,0x02CFD), `Abs (0x02CFD);
+  (0x03192,0x03195), `Delta (0);
+  (0x03220,0x03229), `Delta (0);
+  (0x03248,0x0324F), `Delta (0);
+  (0x03251,0x0325F), `Delta (0);
+  (0x03280,0x03289), `Delta (0);
+  (0x032B1,0x032BF), `Delta (0);
+  (0x0A830,0x0A835), `Delta (0);
+  (0x10107,0x10133), `Delta (0);
+  (0x10175,0x10178), `Delta (0);
+  (0x1018A,0x1018B), `Delta (0);
+  (0x102E1,0x102FB), `Delta (0);
+  (0x10320,0x10323), `Delta (0);
+  (0x10858,0x1085F), `Delta (0);
+  (0x10879,0x1087F), `Delta (0);
+  (0x108A7,0x108AF), `Delta (0);
+  (0x108FB,0x108FF), `Delta (0);
+  (0x10916,0x1091B), `Delta (0);
+  (0x109BC,0x109BD), `Delta (0);
+  (0x109C0,0x109CF), `Delta (0);
+  (0x109D2,0x109FF), `Delta (0);
+  (0x10A40,0x10A47), `Delta (0);
+  (0x10A7D,0x10A7E), `Delta (0);
+  (0x10A9D,0x10A9F), `Delta (0);
+  (0x10AEB,0x10AEF), `Delta (0);
+  (0x10B58,0x10B5F), `Delta (0);
+  (0x10B78,0x10B7F), `Delta (0);
+  (0x10BA9,0x10BAF), `Delta (0);
+  (0x10CFA,0x10CFF), `Delta (0);
+  (0x10E60,0x10E7E), `Delta (0);
+  (0x11052,0x11065), `Delta (0);
+  (0x111E1,0x111F4), `Delta (0);
+  (0x1173A,0x1173B), `Delta (0);
+  (0x118EA,0x118F2), `Delta (0);
+  (0x11C5A,0x11C6C), `Delta (0);
+  (0x16B5B,0x16B61), `Delta (0);
+  (0x1D360,0x1D371), `Delta (0);
+  (0x1E8C7,0x1E8CF), `Delta (0);
+  (0x1F100,0x1F10C), `Delta (0);
+  (0x00020,0x00020), `Abs (0x00020);
+  (0x000A0,0x000A0), `Abs (0x000A0);
+  (0x01680,0x01680), `Abs (0x01680);
+  (0x02000,0x0200A), `Delta (0);
+  (0x0202F,0x0202F), `Abs (0x0202F);
+  (0x0205F,0x0205F), `Abs (0x0205F);
+  (0x03000,0x03000), `Abs (0x03000);
+  (0x02028,0x02029), `Delta (0);
+  (0x00001,0x0001F), `Delta (0);
+  (0x0007F,0x0009F), `Delta (0);
+  (0x000AD,0x000AD), `Abs (0x000AD);
+  (0x00600,0x00605), `Delta (0);
+  (0x0061C,0x0061C), `Abs (0x0061C);
+  (0x006DD,0x006DD), `Abs (0x006DD);
+  (0x0070F,0x0070F), `Abs (0x0070F);
+  (0x008E2,0x008E2), `Abs (0x008E2);
+  (0x0180E,0x0180E), `Abs (0x0180E);
+  (0x0200B,0x0200F), `Delta (0);
+  (0x0202A,0x0202E), `Delta (0);
+  (0x02060,0x02064), `Delta (0);
+  (0x02066,0x0206F), `Delta (0);
+  (0x0FEFF,0x0FEFF), `Abs (0x0FEFF);
+  (0x0FFF9,0x0FFFB), `Delta (0);
+  (0x110BD,0x110BD), `Abs (0x110BD);
+  (0x1BCA0,0x1BCA3), `Delta (0);
+  (0x1D173,0x1D17A), `Delta (0);
+  (0xE0001,0xE0001), `Abs (0xE0001);
+  (0xE0020,0xE007F), `Delta (0);
+  (0x0D800,0x0F8FF), `Delta (0);
+  (0xF0000,0xFFFFD), `Delta (0);
+  (0x100000,0x10FFFD), `Delta (0);
+  (0x00378,0x00379), `Delta (0);
+  (0x00380,0x00383), `Delta (0);
+  (0x0038B,0x0038B), `Abs (0x0038B);
+  (0x0038D,0x0038D), `Abs (0x0038D);
+  (0x003A2,0x003A2), `Abs (0x003A2);
+  (0x00530,0x00530), `Abs (0x00530);
+  (0x00557,0x00558), `Delta (0);
+  (0x00560,0x00560), `Abs (0x00560);
+  (0x00588,0x00588), `Abs (0x00588);
+  (0x0058B,0x0058C), `Delta (0);
+  (0x00590,0x00590), `Abs (0x00590);
+  (0x005C8,0x005CF), `Delta (0);
+  (0x005EB,0x005EF), `Delta (0);
+  (0x005F5,0x005FF), `Delta (0);
+  (0x0061D,0x0061D), `Abs (0x0061D);
+  (0x0070E,0x0070E), `Abs (0x0070E);
+  (0x0074B,0x0074C), `Delta (0);
+  (0x007B2,0x007BF), `Delta (0);
+  (0x007FB,0x007FF), `Delta (0);
+  (0x0082E,0x0082F), `Delta (0);
+  (0x0083F,0x0083F), `Abs (0x0083F);
+  (0x0085C,0x0085D), `Delta (0);
+  (0x0085F,0x0089F), `Delta (0);
+  (0x008B5,0x008B5), `Abs (0x008B5);
+  (0x008BE,0x008D3), `Delta (0);
+  (0x00984,0x00984), `Abs (0x00984);
+  (0x0098D,0x0098E), `Delta (0);
+  (0x00991,0x00992), `Delta (0);
+  (0x009A9,0x009A9), `Abs (0x009A9);
+  (0x009B1,0x009B1), `Abs (0x009B1);
+  (0x009B3,0x009B5), `Delta (0);
+  (0x009BA,0x009BB), `Delta (0);
+  (0x009C5,0x009C6), `Delta (0);
+  (0x009C9,0x009CA), `Delta (0);
+  (0x009CF,0x009D6), `Delta (0);
+  (0x009D8,0x009DB), `Delta (0);
+  (0x009DE,0x009DE), `Abs (0x009DE);
+  (0x009E4,0x009E5), `Delta (0);
+  (0x009FC,0x00A00), `Delta (0);
+  (0x00A04,0x00A04), `Abs (0x00A04);
+  (0x00A0B,0x00A0E), `Delta (0);
+  (0x00A11,0x00A12), `Delta (0);
+  (0x00A29,0x00A29), `Abs (0x00A29);
+  (0x00A31,0x00A31), `Abs (0x00A31);
+  (0x00A34,0x00A34), `Abs (0x00A34);
+  (0x00A37,0x00A37), `Abs (0x00A37);
+  (0x00A3A,0x00A3B), `Delta (0);
+  (0x00A3D,0x00A3D), `Abs (0x00A3D);
+  (0x00A43,0x00A46), `Delta (0);
+  (0x00A49,0x00A4A), `Delta (0);
+  (0x00A4E,0x00A50), `Delta (0);
+  (0x00A52,0x00A58), `Delta (0);
+  (0x00A5D,0x00A5D), `Abs (0x00A5D);
+  (0x00A5F,0x00A65), `Delta (0);
+  (0x00A76,0x00A80), `Delta (0);
+  (0x00A84,0x00A84), `Abs (0x00A84);
+  (0x00A8E,0x00A8E), `Abs (0x00A8E);
+  (0x00A92,0x00A92), `Abs (0x00A92);
+  (0x00AA9,0x00AA9), `Abs (0x00AA9);
+  (0x00AB1,0x00AB1), `Abs (0x00AB1);
+  (0x00AB4,0x00AB4), `Abs (0x00AB4);
+  (0x00ABA,0x00ABB), `Delta (0);
+  (0x00AC6,0x00AC6), `Abs (0x00AC6);
+  (0x00ACA,0x00ACA), `Abs (0x00ACA);
+  (0x00ACE,0x00ACF), `Delta (0);
+  (0x00AD1,0x00ADF), `Delta (0);
+  (0x00AE4,0x00AE5), `Delta (0);
+  (0x00AF2,0x00AF8), `Delta (0);
+  (0x00AFA,0x00B00), `Delta (0);
+  (0x00B04,0x00B04), `Abs (0x00B04);
+  (0x00B0D,0x00B0E), `Delta (0);
+  (0x00B11,0x00B12), `Delta (0);
+  (0x00B29,0x00B29), `Abs (0x00B29);
+  (0x00B31,0x00B31), `Abs (0x00B31);
+  (0x00B34,0x00B34), `Abs (0x00B34);
+  (0x00B3A,0x00B3B), `Delta (0);
+  (0x00B45,0x00B46), `Delta (0);
+  (0x00B49,0x00B4A), `Delta (0);
+  (0x00B4E,0x00B55), `Delta (0);
+  (0x00B58,0x00B5B), `Delta (0);
+  (0x00B5E,0x00B5E), `Abs (0x00B5E);
+  (0x00B64,0x00B65), `Delta (0);
+  (0x00B78,0x00B81), `Delta (0);
+  (0x00B84,0x00B84), `Abs (0x00B84);
+  (0x00B8B,0x00B8D), `Delta (0);
+  (0x00B91,0x00B91), `Abs (0x00B91);
+  (0x00B96,0x00B98), `Delta (0);
+  (0x00B9B,0x00B9B), `Abs (0x00B9B);
+  (0x00B9D,0x00B9D), `Abs (0x00B9D);
+  (0x00BA0,0x00BA2), `Delta (0);
+  (0x00BA5,0x00BA7), `Delta (0);
+  (0x00BAB,0x00BAD), `Delta (0);
+  (0x00BBA,0x00BBD), `Delta (0);
+  (0x00BC3,0x00BC5), `Delta (0);
+  (0x00BC9,0x00BC9), `Abs (0x00BC9);
+  (0x00BCE,0x00BCF), `Delta (0);
+  (0x00BD1,0x00BD6), `Delta (0);
+  (0x00BD8,0x00BE5), `Delta (0);
+  (0x00BFB,0x00BFF), `Delta (0);
+  (0x00C04,0x00C04), `Abs (0x00C04);
+  (0x00C0D,0x00C0D), `Abs (0x00C0D);
+  (0x00C11,0x00C11), `Abs (0x00C11);
+  (0x00C29,0x00C29), `Abs (0x00C29);
+  (0x00C3A,0x00C3C), `Delta (0);
+  (0x00C45,0x00C45), `Abs (0x00C45);
+  (0x00C49,0x00C49), `Abs (0x00C49);
+  (0x00C4E,0x00C54), `Delta (0);
+  (0x00C57,0x00C57), `Abs (0x00C57);
+  (0x00C5B,0x00C5F), `Delta (0);
+  (0x00C64,0x00C65), `Delta (0);
+  (0x00C70,0x00C77), `Delta (0);
+  (0x00C84,0x00C84), `Abs (0x00C84);
+  (0x00C8D,0x00C8D), `Abs (0x00C8D);
+  (0x00C91,0x00C91), `Abs (0x00C91);
+  (0x00CA9,0x00CA9), `Abs (0x00CA9);
+  (0x00CB4,0x00CB4), `Abs (0x00CB4);
+  (0x00CBA,0x00CBB), `Delta (0);
+  (0x00CC5,0x00CC5), `Abs (0x00CC5);
+  (0x00CC9,0x00CC9), `Abs (0x00CC9);
+  (0x00CCE,0x00CD4), `Delta (0);
+  (0x00CD7,0x00CDD), `Delta (0);
+  (0x00CDF,0x00CDF), `Abs (0x00CDF);
+  (0x00CE4,0x00CE5), `Delta (0);
+  (0x00CF0,0x00CF0), `Abs (0x00CF0);
+  (0x00CF3,0x00D00), `Delta (0);
+  (0x00D04,0x00D04), `Abs (0x00D04);
+  (0x00D0D,0x00D0D), `Abs (0x00D0D);
+  (0x00D11,0x00D11), `Abs (0x00D11);
+  (0x00D3B,0x00D3C), `Delta (0);
+  (0x00D45,0x00D45), `Abs (0x00D45);
+  (0x00D49,0x00D49), `Abs (0x00D49);
+  (0x00D50,0x00D53), `Delta (0);
+  (0x00D64,0x00D65), `Delta (0);
+  (0x00D80,0x00D81), `Delta (0);
+  (0x00D84,0x00D84), `Abs (0x00D84);
+  (0x00D97,0x00D99), `Delta (0);
+  (0x00DB2,0x00DB2), `Abs (0x00DB2);
+  (0x00DBC,0x00DBC), `Abs (0x00DBC);
+  (0x00DBE,0x00DBF), `Delta (0);
+  (0x00DC7,0x00DC9), `Delta (0);
+  (0x00DCB,0x00DCE), `Delta (0);
+  (0x00DD5,0x00DD5), `Abs (0x00DD5);
+  (0x00DD7,0x00DD7), `Abs (0x00DD7);
+  (0x00DE0,0x00DE5), `Delta (0);
+  (0x00DF0,0x00DF1), `Delta (0);
+  (0x00DF5,0x00E00), `Delta (0);
+  (0x00E3B,0x00E3E), `Delta (0);
+  (0x00E5C,0x00E80), `Delta (0);
+  (0x00E83,0x00E83), `Abs (0x00E83);
+  (0x00E85,0x00E86), `Delta (0);
+  (0x00E89,0x00E89), `Abs (0x00E89);
+  (0x00E8B,0x00E8C), `Delta (0);
+  (0x00E8E,0x00E93), `Delta (0);
+  (0x00E98,0x00E98), `Abs (0x00E98);
+  (0x00EA0,0x00EA0), `Abs (0x00EA0);
+  (0x00EA4,0x00EA4), `Abs (0x00EA4);
+  (0x00EA6,0x00EA6), `Abs (0x00EA6);
+  (0x00EA8,0x00EA9), `Delta (0);
+  (0x00EAC,0x00EAC), `Abs (0x00EAC);
+  (0x00EBA,0x00EBA), `Abs (0x00EBA);
+  (0x00EBE,0x00EBF), `Delta (0);
+  (0x00EC5,0x00EC5), `Abs (0x00EC5);
+  (0x00EC7,0x00EC7), `Abs (0x00EC7);
+  (0x00ECE,0x00ECF), `Delta (0);
+  (0x00EDA,0x00EDB), `Delta (0);
+  (0x00EE0,0x00EFF), `Delta (0);
+  (0x00F48,0x00F48), `Abs (0x00F48);
+  (0x00F6D,0x00F70), `Delta (0);
+  (0x00F98,0x00F98), `Abs (0x00F98);
+  (0x00FBD,0x00FBD), `Abs (0x00FBD);
+  (0x00FCD,0x00FCD), `Abs (0x00FCD);
+  (0x00FDB,0x00FFF), `Delta (0);
+  (0x010C6,0x010C6), `Abs (0x010C6);
+  (0x010C8,0x010CC), `Delta (0);
+  (0x010CE,0x010CF), `Delta (0);
+  (0x01249,0x01249), `Abs (0x01249);
+  (0x0124E,0x0124F), `Delta (0);
+  (0x01257,0x01257), `Abs (0x01257);
+  (0x01259,0x01259), `Abs (0x01259);
+  (0x0125E,0x0125F), `Delta (0);
+  (0x01289,0x01289), `Abs (0x01289);
+  (0x0128E,0x0128F), `Delta (0);
+  (0x012B1,0x012B1), `Abs (0x012B1);
+  (0x012B6,0x012B7), `Delta (0);
+  (0x012BF,0x012BF), `Abs (0x012BF);
+  (0x012C1,0x012C1), `Abs (0x012C1);
+  (0x012C6,0x012C7), `Delta (0);
+  (0x012D7,0x012D7), `Abs (0x012D7);
+  (0x01311,0x01311), `Abs (0x01311);
+  (0x01316,0x01317), `Delta (0);
+  (0x0135B,0x0135C), `Delta (0);
+  (0x0137D,0x0137F), `Delta (0);
+  (0x0139A,0x0139F), `Delta (0);
+  (0x013F6,0x013F7), `Delta (0);
+  (0x013FE,0x013FF), `Delta (0);
+  (0x0169D,0x0169F), `Delta (0);
+  (0x016F9,0x016FF), `Delta (0);
+  (0x0170D,0x0170D), `Abs (0x0170D);
+  (0x01715,0x0171F), `Delta (0);
+  (0x01737,0x0173F), `Delta (0);
+  (0x01754,0x0175F), `Delta (0);
+  (0x0176D,0x0176D), `Abs (0x0176D);
+  (0x01771,0x01771), `Abs (0x01771);
+  (0x01774,0x0177F), `Delta (0);
+  (0x017DE,0x017DF), `Delta (0);
+  (0x017EA,0x017EF), `Delta (0);
+  (0x017FA,0x017FF), `Delta (0);
+  (0x0180F,0x0180F), `Abs (0x0180F);
+  (0x0181A,0x0181F), `Delta (0);
+  (0x01878,0x0187F), `Delta (0);
+  (0x018AB,0x018AF), `Delta (0);
+  (0x018F6,0x018FF), `Delta (0);
+  (0x0191F,0x0191F), `Abs (0x0191F);
+  (0x0192C,0x0192F), `Delta (0);
+  (0x0193C,0x0193F), `Delta (0);
+  (0x01941,0x01943), `Delta (0);
+  (0x0196E,0x0196F), `Delta (0);
+  (0x01975,0x0197F), `Delta (0);
+  (0x019AC,0x019AF), `Delta (0);
+  (0x019CA,0x019CF), `Delta (0);
+  (0x019DB,0x019DD), `Delta (0);
+  (0x01A1C,0x01A1D), `Delta (0);
+  (0x01A5F,0x01A5F), `Abs (0x01A5F);
+  (0x01A7D,0x01A7E), `Delta (0);
+  (0x01A8A,0x01A8F), `Delta (0);
+  (0x01A9A,0x01A9F), `Delta (0);
+  (0x01AAE,0x01AAF), `Delta (0);
+  (0x01ABF,0x01AFF), `Delta (0);
+  (0x01B4C,0x01B4F), `Delta (0);
+  (0x01B7D,0x01B7F), `Delta (0);
+  (0x01BF4,0x01BFB), `Delta (0);
+  (0x01C38,0x01C3A), `Delta (0);
+  (0x01C4A,0x01C4C), `Delta (0);
+  (0x01C89,0x01CBF), `Delta (0);
+  (0x01CC8,0x01CCF), `Delta (0);
+  (0x01CF7,0x01CF7), `Abs (0x01CF7);
+  (0x01CFA,0x01CFF), `Delta (0);
+  (0x01DF6,0x01DFA), `Delta (0);
+  (0x01F16,0x01F17), `Delta (0);
+  (0x01F1E,0x01F1F), `Delta (0);
+  (0x01F46,0x01F47), `Delta (0);
+  (0x01F4E,0x01F4F), `Delta (0);
+  (0x01F58,0x01F58), `Abs (0x01F58);
+  (0x01F5A,0x01F5A), `Abs (0x01F5A);
+  (0x01F5C,0x01F5C), `Abs (0x01F5C);
+  (0x01F5E,0x01F5E), `Abs (0x01F5E);
+  (0x01F7E,0x01F7F), `Delta (0);
+  (0x01FB5,0x01FB5), `Abs (0x01FB5);
+  (0x01FC5,0x01FC5), `Abs (0x01FC5);
+  (0x01FD4,0x01FD5), `Delta (0);
+  (0x01FDC,0x01FDC), `Abs (0x01FDC);
+  (0x01FF0,0x01FF1), `Delta (0);
+  (0x01FF5,0x01FF5), `Abs (0x01FF5);
+  (0x01FFF,0x01FFF), `Abs (0x01FFF);
+  (0x02065,0x02065), `Abs (0x02065);
+  (0x02072,0x02073), `Delta (0);
+  (0x0208F,0x0208F), `Abs (0x0208F);
+  (0x0209D,0x0209F), `Delta (0);
+  (0x020BF,0x020CF), `Delta (0);
+  (0x020F1,0x020FF), `Delta (0);
+  (0x0218C,0x0218F), `Delta (0);
+  (0x023FF,0x023FF), `Abs (0x023FF);
+  (0x02427,0x0243F), `Delta (0);
+  (0x0244B,0x0245F), `Delta (0);
+  (0x02B74,0x02B75), `Delta (0);
+  (0x02B96,0x02B97), `Delta (0);
+  (0x02BBA,0x02BBC), `Delta (0);
+  (0x02BC9,0x02BC9), `Abs (0x02BC9);
+  (0x02BD2,0x02BEB), `Delta (0);
+  (0x02BF0,0x02BFF), `Delta (0);
+  (0x02C2F,0x02C2F), `Abs (0x02C2F);
+  (0x02C5F,0x02C5F), `Abs (0x02C5F);
+  (0x02CF4,0x02CF8), `Delta (0);
+  (0x02D26,0x02D26), `Abs (0x02D26);
+  (0x02D28,0x02D2C), `Delta (0);
+  (0x02D2E,0x02D2F), `Delta (0);
+  (0x02D68,0x02D6E), `Delta (0);
+  (0x02D71,0x02D7E), `Delta (0);
+  (0x02D97,0x02D9F), `Delta (0);
+  (0x02DA7,0x02DA7), `Abs (0x02DA7);
+  (0x02DAF,0x02DAF), `Abs (0x02DAF);
+  (0x02DB7,0x02DB7), `Abs (0x02DB7);
+  (0x02DBF,0x02DBF), `Abs (0x02DBF);
+  (0x02DC7,0x02DC7), `Abs (0x02DC7);
+  (0x02DCF,0x02DCF), `Abs (0x02DCF);
+  (0x02DD7,0x02DD7), `Abs (0x02DD7);
+  (0x02DDF,0x02DDF), `Abs (0x02DDF);
+  (0x02E45,0x02E7F), `Delta (0);
+  (0x02E9A,0x02E9A), `Abs (0x02E9A);
+  (0x02EF4,0x02EFF), `Delta (0);
+  (0x02FD6,0x02FEF), `Delta (0);
+  (0x02FFC,0x02FFF), `Delta (0);
+  (0x03040,0x03040), `Abs (0x03040);
+  (0x03097,0x03098), `Delta (0);
+  (0x03100,0x03104), `Delta (0);
+  (0x0312E,0x03130), `Delta (0);
+  (0x0318F,0x0318F), `Abs (0x0318F);
+  (0x031BB,0x031BF), `Delta (0);
+  (0x031E4,0x031EF), `Delta (0);
+  (0x0321F,0x0321F), `Abs (0x0321F);
+  (0x032FF,0x032FF), `Abs (0x032FF);
+  (0x04DB6,0x04DBF), `Delta (0);
+  (0x09FD6,0x09FFF), `Delta (0);
+  (0x0A48D,0x0A48F), `Delta (0);
+  (0x0A4C7,0x0A4CF), `Delta (0);
+  (0x0A62C,0x0A63F), `Delta (0);
+  (0x0A6F8,0x0A6FF), `Delta (0);
+  (0x0A7AF,0x0A7AF), `Abs (0x0A7AF);
+  (0x0A7B8,0x0A7F6), `Delta (0);
+  (0x0A82C,0x0A82F), `Delta (0);
+  (0x0A83A,0x0A83F), `Delta (0);
+  (0x0A878,0x0A87F), `Delta (0);
+  (0x0A8C6,0x0A8CD), `Delta (0);
+  (0x0A8DA,0x0A8DF), `Delta (0);
+  (0x0A8FE,0x0A8FF), `Delta (0);
+  (0x0A954,0x0A95E), `Delta (0);
+  (0x0A97D,0x0A97F), `Delta (0);
+  (0x0A9CE,0x0A9CE), `Abs (0x0A9CE);
+  (0x0A9DA,0x0A9DD), `Delta (0);
+  (0x0A9FF,0x0A9FF), `Abs (0x0A9FF);
+  (0x0AA37,0x0AA3F), `Delta (0);
+  (0x0AA4E,0x0AA4F), `Delta (0);
+  (0x0AA5A,0x0AA5B), `Delta (0);
+  (0x0AAC3,0x0AADA), `Delta (0);
+  (0x0AAF7,0x0AB00), `Delta (0);
+  (0x0AB07,0x0AB08), `Delta (0);
+  (0x0AB0F,0x0AB10), `Delta (0);
+  (0x0AB17,0x0AB1F), `Delta (0);
+  (0x0AB27,0x0AB27), `Abs (0x0AB27);
+  (0x0AB2F,0x0AB2F), `Abs (0x0AB2F);
+  (0x0AB66,0x0AB6F), `Delta (0);
+  (0x0ABEE,0x0ABEF), `Delta (0);
+  (0x0ABFA,0x0ABFF), `Delta (0);
+  (0x0D7A4,0x0D7AF), `Delta (0);
+  (0x0D7C7,0x0D7CA), `Delta (0);
+  (0x0D7FC,0x0D7FF), `Delta (0);
+  (0x0FA6E,0x0FA6F), `Delta (0);
+  (0x0FADA,0x0FAFF), `Delta (0);
+  (0x0FB07,0x0FB12), `Delta (0);
+  (0x0FB18,0x0FB1C), `Delta (0);
+  (0x0FB37,0x0FB37), `Abs (0x0FB37);
+  (0x0FB3D,0x0FB3D), `Abs (0x0FB3D);
+  (0x0FB3F,0x0FB3F), `Abs (0x0FB3F);
+  (0x0FB42,0x0FB42), `Abs (0x0FB42);
+  (0x0FB45,0x0FB45), `Abs (0x0FB45);
+  (0x0FBC2,0x0FBD2), `Delta (0);
+  (0x0FD40,0x0FD4F), `Delta (0);
+  (0x0FD90,0x0FD91), `Delta (0);
+  (0x0FDC8,0x0FDEF), `Delta (0);
+  (0x0FDFE,0x0FDFF), `Delta (0);
+  (0x0FE1A,0x0FE1F), `Delta (0);
+  (0x0FE53,0x0FE53), `Abs (0x0FE53);
+  (0x0FE67,0x0FE67), `Abs (0x0FE67);
+  (0x0FE6C,0x0FE6F), `Delta (0);
+  (0x0FE75,0x0FE75), `Abs (0x0FE75);
+  (0x0FEFD,0x0FEFE), `Delta (0);
+  (0x0FF00,0x0FF00), `Abs (0x0FF00);
+  (0x0FFBF,0x0FFC1), `Delta (0);
+  (0x0FFC8,0x0FFC9), `Delta (0);
+  (0x0FFD0,0x0FFD1), `Delta (0);
+  (0x0FFD8,0x0FFD9), `Delta (0);
+  (0x0FFDD,0x0FFDF), `Delta (0);
+  (0x0FFE7,0x0FFE7), `Abs (0x0FFE7);
+  (0x0FFEF,0x0FFF8), `Delta (0);
+  (0x0FFFE,0x0FFFF), `Delta (0);
+  (0x1000C,0x1000C), `Abs (0x1000C);
+  (0x10027,0x10027), `Abs (0x10027);
+  (0x1003B,0x1003B), `Abs (0x1003B);
+  (0x1003E,0x1003E), `Abs (0x1003E);
+  (0x1004E,0x1004F), `Delta (0);
+  (0x1005E,0x1007F), `Delta (0);
+  (0x100FB,0x100FF), `Delta (0);
+  (0x10103,0x10106), `Delta (0);
+  (0x10134,0x10136), `Delta (0);
+  (0x1018F,0x1018F), `Abs (0x1018F);
+  (0x1019C,0x1019F), `Delta (0);
+  (0x101A1,0x101CF), `Delta (0);
+  (0x101FE,0x1027F), `Delta (0);
+  (0x1029D,0x1029F), `Delta (0);
+  (0x102D1,0x102DF), `Delta (0);
+  (0x102FC,0x102FF), `Delta (0);
+  (0x10324,0x1032F), `Delta (0);
+  (0x1034B,0x1034F), `Delta (0);
+  (0x1037B,0x1037F), `Delta (0);
+  (0x1039E,0x1039E), `Abs (0x1039E);
+  (0x103C4,0x103C7), `Delta (0);
+  (0x103D6,0x103FF), `Delta (0);
+  (0x1049E,0x1049F), `Delta (0);
+  (0x104AA,0x104AF), `Delta (0);
+  (0x104D4,0x104D7), `Delta (0);
+  (0x104FC,0x104FF), `Delta (0);
+  (0x10528,0x1052F), `Delta (0);
+  (0x10564,0x1056E), `Delta (0);
+  (0x10570,0x105FF), `Delta (0);
+  (0x10737,0x1073F), `Delta (0);
+  (0x10756,0x1075F), `Delta (0);
+  (0x10768,0x107FF), `Delta (0);
+  (0x10806,0x10807), `Delta (0);
+  (0x10809,0x10809), `Abs (0x10809);
+  (0x10836,0x10836), `Abs (0x10836);
+  (0x10839,0x1083B), `Delta (0);
+  (0x1083D,0x1083E), `Delta (0);
+  (0x10856,0x10856), `Abs (0x10856);
+  (0x1089F,0x108A6), `Delta (0);
+  (0x108B0,0x108DF), `Delta (0);
+  (0x108F3,0x108F3), `Abs (0x108F3);
+  (0x108F6,0x108FA), `Delta (0);
+  (0x1091C,0x1091E), `Delta (0);
+  (0x1093A,0x1093E), `Delta (0);
+  (0x10940,0x1097F), `Delta (0);
+  (0x109B8,0x109BB), `Delta (0);
+  (0x109D0,0x109D1), `Delta (0);
+  (0x10A04,0x10A04), `Abs (0x10A04);
+  (0x10A07,0x10A0B), `Delta (0);
+  (0x10A14,0x10A14), `Abs (0x10A14);
+  (0x10A18,0x10A18), `Abs (0x10A18);
+  (0x10A34,0x10A37), `Delta (0);
+  (0x10A3B,0x10A3E), `Delta (0);
+  (0x10A48,0x10A4F), `Delta (0);
+  (0x10A59,0x10A5F), `Delta (0);
+  (0x10AA0,0x10ABF), `Delta (0);
+  (0x10AE7,0x10AEA), `Delta (0);
+  (0x10AF7,0x10AFF), `Delta (0);
+  (0x10B36,0x10B38), `Delta (0);
+  (0x10B56,0x10B57), `Delta (0);
+  (0x10B73,0x10B77), `Delta (0);
+  (0x10B92,0x10B98), `Delta (0);
+  (0x10B9D,0x10BA8), `Delta (0);
+  (0x10BB0,0x10BFF), `Delta (0);
+  (0x10C49,0x10C7F), `Delta (0);
+  (0x10CB3,0x10CBF), `Delta (0);
+  (0x10CF3,0x10CF9), `Delta (0);
+  (0x10D00,0x10E5F), `Delta (0);
+  (0x10E7F,0x10FFF), `Delta (0);
+  (0x1104E,0x11051), `Delta (0);
+  (0x11070,0x1107E), `Delta (0);
+  (0x110C2,0x110CF), `Delta (0);
+  (0x110E9,0x110EF), `Delta (0);
+  (0x110FA,0x110FF), `Delta (0);
+  (0x11135,0x11135), `Abs (0x11135);
+  (0x11144,0x1114F), `Delta (0);
+  (0x11177,0x1117F), `Delta (0);
+  (0x111CE,0x111CF), `Delta (0);
+  (0x111E0,0x111E0), `Abs (0x111E0);
+  (0x111F5,0x111FF), `Delta (0);
+  (0x11212,0x11212), `Abs (0x11212);
+  (0x1123F,0x1127F), `Delta (0);
+  (0x11287,0x11287), `Abs (0x11287);
+  (0x11289,0x11289), `Abs (0x11289);
+  (0x1128E,0x1128E), `Abs (0x1128E);
+  (0x1129E,0x1129E), `Abs (0x1129E);
+  (0x112AA,0x112AF), `Delta (0);
+  (0x112EB,0x112EF), `Delta (0);
+  (0x112FA,0x112FF), `Delta (0);
+  (0x11304,0x11304), `Abs (0x11304);
+  (0x1130D,0x1130E), `Delta (0);
+  (0x11311,0x11312), `Delta (0);
+  (0x11329,0x11329), `Abs (0x11329);
+  (0x11331,0x11331), `Abs (0x11331);
+  (0x11334,0x11334), `Abs (0x11334);
+  (0x1133A,0x1133B), `Delta (0);
+  (0x11345,0x11346), `Delta (0);
+  (0x11349,0x1134A), `Delta (0);
+  (0x1134E,0x1134F), `Delta (0);
+  (0x11351,0x11356), `Delta (0);
+  (0x11358,0x1135C), `Delta (0);
+  (0x11364,0x11365), `Delta (0);
+  (0x1136D,0x1136F), `Delta (0);
+  (0x11375,0x113FF), `Delta (0);
+  (0x1145A,0x1145A), `Abs (0x1145A);
+  (0x1145C,0x1145C), `Abs (0x1145C);
+  (0x1145E,0x1147F), `Delta (0);
+  (0x114C8,0x114CF), `Delta (0);
+  (0x114DA,0x1157F), `Delta (0);
+  (0x115B6,0x115B7), `Delta (0);
+  (0x115DE,0x115FF), `Delta (0);
+  (0x11645,0x1164F), `Delta (0);
+  (0x1165A,0x1165F), `Delta (0);
+  (0x1166D,0x1167F), `Delta (0);
+  (0x116B8,0x116BF), `Delta (0);
+  (0x116CA,0x116FF), `Delta (0);
+  (0x1171A,0x1171C), `Delta (0);
+  (0x1172C,0x1172F), `Delta (0);
+  (0x11740,0x1189F), `Delta (0);
+  (0x118F3,0x118FE), `Delta (0);
+  (0x11900,0x11ABF), `Delta (0);
+  (0x11AF9,0x11BFF), `Delta (0);
+  (0x11C09,0x11C09), `Abs (0x11C09);
+  (0x11C37,0x11C37), `Abs (0x11C37);
+  (0x11C46,0x11C4F), `Delta (0);
+  (0x11C6D,0x11C6F), `Delta (0);
+  (0x11C90,0x11C91), `Delta (0);
+  (0x11CA8,0x11CA8), `Abs (0x11CA8);
+  (0x11CB7,0x11FFF), `Delta (0);
+  (0x1239A,0x123FF), `Delta (0);
+  (0x1246F,0x1246F), `Abs (0x1246F);
+  (0x12475,0x1247F), `Delta (0);
+  (0x12544,0x12FFF), `Delta (0);
+  (0x1342F,0x143FF), `Delta (0);
+  (0x14647,0x167FF), `Delta (0);
+  (0x16A39,0x16A3F), `Delta (0);
+  (0x16A5F,0x16A5F), `Abs (0x16A5F);
+  (0x16A6A,0x16A6D), `Delta (0);
+  (0x16A70,0x16ACF), `Delta (0);
+  (0x16AEE,0x16AEF), `Delta (0);
+  (0x16AF6,0x16AFF), `Delta (0);
+  (0x16B46,0x16B4F), `Delta (0);
+  (0x16B5A,0x16B5A), `Abs (0x16B5A);
+  (0x16B62,0x16B62), `Abs (0x16B62);
+  (0x16B78,0x16B7C), `Delta (0);
+  (0x16B90,0x16EFF), `Delta (0);
+  (0x16F45,0x16F4F), `Delta (0);
+  (0x16F7F,0x16F8E), `Delta (0);
+  (0x16FA0,0x16FDF), `Delta (0);
+  (0x16FE1,0x16FFF), `Delta (0);
+  (0x187ED,0x187FF), `Delta (0);
+  (0x18AF3,0x1AFFF), `Delta (0);
+  (0x1B002,0x1BBFF), `Delta (0);
+  (0x1BC6B,0x1BC6F), `Delta (0);
+  (0x1BC7D,0x1BC7F), `Delta (0);
+  (0x1BC89,0x1BC8F), `Delta (0);
+  (0x1BC9A,0x1BC9B), `Delta (0);
+  (0x1BCA4,0x1CFFF), `Delta (0);
+  (0x1D0F6,0x1D0FF), `Delta (0);
+  (0x1D127,0x1D128), `Delta (0);
+  (0x1D1E9,0x1D1FF), `Delta (0);
+  (0x1D246,0x1D2FF), `Delta (0);
+  (0x1D357,0x1D35F), `Delta (0);
+  (0x1D372,0x1D3FF), `Delta (0);
+  (0x1D455,0x1D455), `Abs (0x1D455);
+  (0x1D49D,0x1D49D), `Abs (0x1D49D);
+  (0x1D4A0,0x1D4A1), `Delta (0);
+  (0x1D4A3,0x1D4A4), `Delta (0);
+  (0x1D4A7,0x1D4A8), `Delta (0);
+  (0x1D4AD,0x1D4AD), `Abs (0x1D4AD);
+  (0x1D4BA,0x1D4BA), `Abs (0x1D4BA);
+  (0x1D4BC,0x1D4BC), `Abs (0x1D4BC);
+  (0x1D4C4,0x1D4C4), `Abs (0x1D4C4);
+  (0x1D506,0x1D506), `Abs (0x1D506);
+  (0x1D50B,0x1D50C), `Delta (0);
+  (0x1D515,0x1D515), `Abs (0x1D515);
+  (0x1D51D,0x1D51D), `Abs (0x1D51D);
+  (0x1D53A,0x1D53A), `Abs (0x1D53A);
+  (0x1D53F,0x1D53F), `Abs (0x1D53F);
+  (0x1D545,0x1D545), `Abs (0x1D545);
+  (0x1D547,0x1D549), `Delta (0);
+  (0x1D551,0x1D551), `Abs (0x1D551);
+  (0x1D6A6,0x1D6A7), `Delta (0);
+  (0x1D7CC,0x1D7CD), `Delta (0);
+  (0x1DA8C,0x1DA9A), `Delta (0);
+  (0x1DAA0,0x1DAA0), `Abs (0x1DAA0);
+  (0x1DAB0,0x1DFFF), `Delta (0);
+  (0x1E007,0x1E007), `Abs (0x1E007);
+  (0x1E019,0x1E01A), `Delta (0);
+  (0x1E022,0x1E022), `Abs (0x1E022);
+  (0x1E025,0x1E025), `Abs (0x1E025);
+  (0x1E02B,0x1E7FF), `Delta (0);
+  (0x1E8C5,0x1E8C6), `Delta (0);
+  (0x1E8D7,0x1E8FF), `Delta (0);
+  (0x1E94B,0x1E94F), `Delta (0);
+  (0x1E95A,0x1E95D), `Delta (0);
+  (0x1E960,0x1EDFF), `Delta (0);
+  (0x1EE04,0x1EE04), `Abs (0x1EE04);
+  (0x1EE20,0x1EE20), `Abs (0x1EE20);
+  (0x1EE23,0x1EE23), `Abs (0x1EE23);
+  (0x1EE25,0x1EE26), `Delta (0);
+  (0x1EE28,0x1EE28), `Abs (0x1EE28);
+  (0x1EE33,0x1EE33), `Abs (0x1EE33);
+  (0x1EE38,0x1EE38), `Abs (0x1EE38);
+  (0x1EE3A,0x1EE3A), `Abs (0x1EE3A);
+  (0x1EE3C,0x1EE41), `Delta (0);
+  (0x1EE43,0x1EE46), `Delta (0);
+  (0x1EE48,0x1EE48), `Abs (0x1EE48);
+  (0x1EE4A,0x1EE4A), `Abs (0x1EE4A);
+  (0x1EE4C,0x1EE4C), `Abs (0x1EE4C);
+  (0x1EE50,0x1EE50), `Abs (0x1EE50);
+  (0x1EE53,0x1EE53), `Abs (0x1EE53);
+  (0x1EE55,0x1EE56), `Delta (0);
+  (0x1EE58,0x1EE58), `Abs (0x1EE58);
+  (0x1EE5A,0x1EE5A), `Abs (0x1EE5A);
+  (0x1EE5C,0x1EE5C), `Abs (0x1EE5C);
+  (0x1EE5E,0x1EE5E), `Abs (0x1EE5E);
+  (0x1EE60,0x1EE60), `Abs (0x1EE60);
+  (0x1EE63,0x1EE63), `Abs (0x1EE63);
+  (0x1EE65,0x1EE66), `Delta (0);
+  (0x1EE6B,0x1EE6B), `Abs (0x1EE6B);
+  (0x1EE73,0x1EE73), `Abs (0x1EE73);
+  (0x1EE78,0x1EE78), `Abs (0x1EE78);
+  (0x1EE7D,0x1EE7D), `Abs (0x1EE7D);
+  (0x1EE7F,0x1EE7F), `Abs (0x1EE7F);
+  (0x1EE8A,0x1EE8A), `Abs (0x1EE8A);
+  (0x1EE9C,0x1EEA0), `Delta (0);
+  (0x1EEA4,0x1EEA4), `Abs (0x1EEA4);
+  (0x1EEAA,0x1EEAA), `Abs (0x1EEAA);
+  (0x1EEBC,0x1EEEF), `Delta (0);
+  (0x1EEF2,0x1EFFF), `Delta (0);
+  (0x1F02C,0x1F02F), `Delta (0);
+  (0x1F094,0x1F09F), `Delta (0);
+  (0x1F0AF,0x1F0B0), `Delta (0);
+  (0x1F0C0,0x1F0C0), `Abs (0x1F0C0);
+  (0x1F0D0,0x1F0D0), `Abs (0x1F0D0);
+  (0x1F0F6,0x1F0FF), `Delta (0);
+  (0x1F10D,0x1F10F), `Delta (0);
+  (0x1F12F,0x1F12F), `Abs (0x1F12F);
+  (0x1F16C,0x1F16F), `Delta (0);
+  (0x1F1AD,0x1F1E5), `Delta (0);
+  (0x1F203,0x1F20F), `Delta (0);
+  (0x1F23C,0x1F23F), `Delta (0);
+  (0x1F249,0x1F24F), `Delta (0);
+  (0x1F252,0x1F2FF), `Delta (0);
+  (0x1F6D3,0x1F6DF), `Delta (0);
+  (0x1F6ED,0x1F6EF), `Delta (0);
+  (0x1F6F7,0x1F6FF), `Delta (0);
+  (0x1F774,0x1F77F), `Delta (0);
+  (0x1F7D5,0x1F7FF), `Delta (0);
+  (0x1F80C,0x1F80F), `Delta (0);
+  (0x1F848,0x1F84F), `Delta (0);
+  (0x1F85A,0x1F85F), `Delta (0);
+  (0x1F888,0x1F88F), `Delta (0);
+  (0x1F8AE,0x1F90F), `Delta (0);
+  (0x1F91F,0x1F91F), `Abs (0x1F91F);
+  (0x1F928,0x1F92F), `Delta (0);
+  (0x1F931,0x1F932), `Delta (0);
+  (0x1F93F,0x1F93F), `Abs (0x1F93F);
+  (0x1F94C,0x1F94F), `Delta (0);
+  (0x1F95F,0x1F97F), `Delta (0);
+  (0x1F992,0x1F9BF), `Delta (0);
+  (0x1F9C1,0x1FFFF), `Delta (0);
+  (0x2A6D7,0x2A6FF), `Delta (0);
+  (0x2B735,0x2B73F), `Delta (0);
+  (0x2B81E,0x2B81F), `Delta (0);
+  (0x2CEA2,0x2F7FF), `Delta (0);
+  (0x2FA1E,0xE0000), `Delta (0);
+  (0xE0002,0xE001F), `Delta (0);
+  (0xE0080,0xE00FF), `Delta (0);
+  (0xE01F0,0xEFFFF), `Delta (0);
+  (0xFFFFE,0xFFFFF), `Delta (0);
+  (0x10FFFE,0x10FFFF), `Delta (0);
+  (0x002B0,0x002C1), `Delta (0);
+  (0x002C6,0x002D1), `Delta (0);
+  (0x002E0,0x002E4), `Delta (0);
+  (0x002EC,0x002EC), `Abs (0x002EC);
+  (0x002EE,0x002EE), `Abs (0x002EE);
+  (0x00374,0x00374), `Abs (0x00374);
+  (0x0037A,0x0037A), `Abs (0x0037A);
+  (0x00559,0x00559), `Abs (0x00559);
+  (0x00640,0x00640), `Abs (0x00640);
+  (0x006E5,0x006E6), `Delta (0);
+  (0x007F4,0x007F5), `Delta (0);
+  (0x007FA,0x007FA), `Abs (0x007FA);
+  (0x0081A,0x0081A), `Abs (0x0081A);
+  (0x00824,0x00824), `Abs (0x00824);
+  (0x00828,0x00828), `Abs (0x00828);
+  (0x00971,0x00971), `Abs (0x00971);
+  (0x00E46,0x00E46), `Abs (0x00E46);
+  (0x00EC6,0x00EC6), `Abs (0x00EC6);
+  (0x010FC,0x010FC), `Abs (0x010FC);
+  (0x017D7,0x017D7), `Abs (0x017D7);
+  (0x01843,0x01843), `Abs (0x01843);
+  (0x01AA7,0x01AA7), `Abs (0x01AA7);
+  (0x01C78,0x01C7D), `Delta (0);
+  (0x01D2C,0x01D6A), `Delta (0);
+  (0x01D78,0x01D78), `Abs (0x01D78);
+  (0x01D9B,0x01DBF), `Delta (0);
+  (0x02071,0x02071), `Abs (0x02071);
+  (0x0207F,0x0207F), `Abs (0x0207F);
+  (0x02090,0x0209C), `Delta (0);
+  (0x02C7C,0x02C7D), `Delta (0);
+  (0x02D6F,0x02D6F), `Abs (0x02D6F);
+  (0x02E2F,0x02E2F), `Abs (0x02E2F);
+  (0x03005,0x03005), `Abs (0x03005);
+  (0x03031,0x03035), `Delta (0);
+  (0x0303B,0x0303B), `Abs (0x0303B);
+  (0x0309D,0x0309E), `Delta (0);
+  (0x030FC,0x030FE), `Delta (0);
+  (0x0A015,0x0A015), `Abs (0x0A015);
+  (0x0A4F8,0x0A4FD), `Delta (0);
+  (0x0A60C,0x0A60C), `Abs (0x0A60C);
+  (0x0A67F,0x0A67F), `Abs (0x0A67F);
+  (0x0A69C,0x0A69D), `Delta (0);
+  (0x0A717,0x0A71F), `Delta (0);
+  (0x0A770,0x0A770), `Abs (0x0A770);
+  (0x0A788,0x0A788), `Abs (0x0A788);
+  (0x0A7F8,0x0A7F9), `Delta (0);
+  (0x0A9CF,0x0A9CF), `Abs (0x0A9CF);
+  (0x0A9E6,0x0A9E6), `Abs (0x0A9E6);
+  (0x0AA70,0x0AA70), `Abs (0x0AA70);
+  (0x0AADD,0x0AADD), `Abs (0x0AADD);
+  (0x0AAF3,0x0AAF4), `Delta (0);
+  (0x0AB5C,0x0AB5F), `Delta (0);
+  (0x0FF70,0x0FF70), `Abs (0x0FF70);
+  (0x0FF9E,0x0FF9F), `Delta (0);
+  (0x16B40,0x16B43), `Delta (0);
+  (0x16F93,0x16F9F), `Delta (0);
+  (0x16FE0,0x16FE0), `Abs (0x16FE0);
+  (0x000AA,0x000AA), `Abs (0x000AA);
+  (0x000BA,0x000BA), `Abs (0x000BA);
+  (0x001BB,0x001BB), `Abs (0x001BB);
+  (0x001C0,0x001C3), `Delta (0);
+  (0x00294,0x00294), `Abs (0x00294);
+  (0x005D0,0x005EA), `Delta (0);
+  (0x005F0,0x005F2), `Delta (0);
+  (0x00620,0x0063F), `Delta (0);
+  (0x00641,0x0064A), `Delta (0);
+  (0x0066E,0x0066F), `Delta (0);
+  (0x00671,0x006D3), `Delta (0);
+  (0x006D5,0x006D5), `Abs (0x006D5);
+  (0x006EE,0x006EF), `Delta (0);
+  (0x006FA,0x006FC), `Delta (0);
+  (0x006FF,0x006FF), `Abs (0x006FF);
+  (0x00710,0x00710), `Abs (0x00710);
+  (0x00712,0x0072F), `Delta (0);
+  (0x0074D,0x007A5), `Delta (0);
+  (0x007B1,0x007B1), `Abs (0x007B1);
+  (0x007CA,0x007EA), `Delta (0);
+  (0x00800,0x00815), `Delta (0);
+  (0x00840,0x00858), `Delta (0);
+  (0x008A0,0x008B4), `Delta (0);
+  (0x008B6,0x008BD), `Delta (0);
+  (0x00904,0x00939), `Delta (0);
+  (0x0093D,0x0093D), `Abs (0x0093D);
+  (0x00950,0x00950), `Abs (0x00950);
+  (0x00958,0x00961), `Delta (0);
+  (0x00972,0x00980), `Delta (0);
+  (0x00985,0x0098C), `Delta (0);
+  (0x0098F,0x00990), `Delta (0);
+  (0x00993,0x009A8), `Delta (0);
+  (0x009AA,0x009B0), `Delta (0);
+  (0x009B2,0x009B2), `Abs (0x009B2);
+  (0x009B6,0x009B9), `Delta (0);
+  (0x009BD,0x009BD), `Abs (0x009BD);
+  (0x009CE,0x009CE), `Abs (0x009CE);
+  (0x009DC,0x009DD), `Delta (0);
+  (0x009DF,0x009E1), `Delta (0);
+  (0x009F0,0x009F1), `Delta (0);
+  (0x00A05,0x00A0A), `Delta (0);
+  (0x00A0F,0x00A10), `Delta (0);
+  (0x00A13,0x00A28), `Delta (0);
+  (0x00A2A,0x00A30), `Delta (0);
+  (0x00A32,0x00A33), `Delta (0);
+  (0x00A35,0x00A36), `Delta (0);
+  (0x00A38,0x00A39), `Delta (0);
+  (0x00A59,0x00A5C), `Delta (0);
+  (0x00A5E,0x00A5E), `Abs (0x00A5E);
+  (0x00A72,0x00A74), `Delta (0);
+  (0x00A85,0x00A8D), `Delta (0);
+  (0x00A8F,0x00A91), `Delta (0);
+  (0x00A93,0x00AA8), `Delta (0);
+  (0x00AAA,0x00AB0), `Delta (0);
+  (0x00AB2,0x00AB3), `Delta (0);
+  (0x00AB5,0x00AB9), `Delta (0);
+  (0x00ABD,0x00ABD), `Abs (0x00ABD);
+  (0x00AD0,0x00AD0), `Abs (0x00AD0);
+  (0x00AE0,0x00AE1), `Delta (0);
+  (0x00AF9,0x00AF9), `Abs (0x00AF9);
+  (0x00B05,0x00B0C), `Delta (0);
+  (0x00B0F,0x00B10), `Delta (0);
+  (0x00B13,0x00B28), `Delta (0);
+  (0x00B2A,0x00B30), `Delta (0);
+  (0x00B32,0x00B33), `Delta (0);
+  (0x00B35,0x00B39), `Delta (0);
+  (0x00B3D,0x00B3D), `Abs (0x00B3D);
+  (0x00B5C,0x00B5D), `Delta (0);
+  (0x00B5F,0x00B61), `Delta (0);
+  (0x00B71,0x00B71), `Abs (0x00B71);
+  (0x00B83,0x00B83), `Abs (0x00B83);
+  (0x00B85,0x00B8A), `Delta (0);
+  (0x00B8E,0x00B90), `Delta (0);
+  (0x00B92,0x00B95), `Delta (0);
+  (0x00B99,0x00B9A), `Delta (0);
+  (0x00B9C,0x00B9C), `Abs (0x00B9C);
+  (0x00B9E,0x00B9F), `Delta (0);
+  (0x00BA3,0x00BA4), `Delta (0);
+  (0x00BA8,0x00BAA), `Delta (0);
+  (0x00BAE,0x00BB9), `Delta (0);
+  (0x00BD0,0x00BD0), `Abs (0x00BD0);
+  (0x00C05,0x00C0C), `Delta (0);
+  (0x00C0E,0x00C10), `Delta (0);
+  (0x00C12,0x00C28), `Delta (0);
+  (0x00C2A,0x00C39), `Delta (0);
+  (0x00C3D,0x00C3D), `Abs (0x00C3D);
+  (0x00C58,0x00C5A), `Delta (0);
+  (0x00C60,0x00C61), `Delta (0);
+  (0x00C80,0x00C80), `Abs (0x00C80);
+  (0x00C85,0x00C8C), `Delta (0);
+  (0x00C8E,0x00C90), `Delta (0);
+  (0x00C92,0x00CA8), `Delta (0);
+  (0x00CAA,0x00CB3), `Delta (0);
+  (0x00CB5,0x00CB9), `Delta (0);
+  (0x00CBD,0x00CBD), `Abs (0x00CBD);
+  (0x00CDE,0x00CDE), `Abs (0x00CDE);
+  (0x00CE0,0x00CE1), `Delta (0);
+  (0x00CF1,0x00CF2), `Delta (0);
+  (0x00D05,0x00D0C), `Delta (0);
+  (0x00D0E,0x00D10), `Delta (0);
+  (0x00D12,0x00D3A), `Delta (0);
+  (0x00D3D,0x00D3D), `Abs (0x00D3D);
+  (0x00D4E,0x00D4E), `Abs (0x00D4E);
+  (0x00D54,0x00D56), `Delta (0);
+  (0x00D5F,0x00D61), `Delta (0);
+  (0x00D7A,0x00D7F), `Delta (0);
+  (0x00D85,0x00D96), `Delta (0);
+  (0x00D9A,0x00DB1), `Delta (0);
+  (0x00DB3,0x00DBB), `Delta (0);
+  (0x00DBD,0x00DBD), `Abs (0x00DBD);
+  (0x00DC0,0x00DC6), `Delta (0);
+  (0x00E01,0x00E30), `Delta (0);
+  (0x00E32,0x00E33), `Delta (0);
+  (0x00E40,0x00E45), `Delta (0);
+  (0x00E81,0x00E82), `Delta (0);
+  (0x00E84,0x00E84), `Abs (0x00E84);
+  (0x00E87,0x00E88), `Delta (0);
+  (0x00E8A,0x00E8A), `Abs (0x00E8A);
+  (0x00E8D,0x00E8D), `Abs (0x00E8D);
+  (0x00E94,0x00E97), `Delta (0);
+  (0x00E99,0x00E9F), `Delta (0);
+  (0x00EA1,0x00EA3), `Delta (0);
+  (0x00EA5,0x00EA5), `Abs (0x00EA5);
+  (0x00EA7,0x00EA7), `Abs (0x00EA7);
+  (0x00EAA,0x00EAB), `Delta (0);
+  (0x00EAD,0x00EB0), `Delta (0);
+  (0x00EB2,0x00EB3), `Delta (0);
+  (0x00EBD,0x00EBD), `Abs (0x00EBD);
+  (0x00EC0,0x00EC4), `Delta (0);
+  (0x00EDC,0x00EDF), `Delta (0);
+  (0x00F00,0x00F00), `Abs (0x00F00);
+  (0x00F40,0x00F47), `Delta (0);
+  (0x00F49,0x00F6C), `Delta (0);
+  (0x00F88,0x00F8C), `Delta (0);
+  (0x01000,0x0102A), `Delta (0);
+  (0x0103F,0x0103F), `Abs (0x0103F);
+  (0x01050,0x01055), `Delta (0);
+  (0x0105A,0x0105D), `Delta (0);
+  (0x01061,0x01061), `Abs (0x01061);
+  (0x01065,0x01066), `Delta (0);
+  (0x0106E,0x01070), `Delta (0);
+  (0x01075,0x01081), `Delta (0);
+  (0x0108E,0x0108E), `Abs (0x0108E);
+  (0x010D0,0x010FA), `Delta (0);
+  (0x010FD,0x01248), `Delta (0);
+  (0x0124A,0x0124D), `Delta (0);
+  (0x01250,0x01256), `Delta (0);
+  (0x01258,0x01258), `Abs (0x01258);
+  (0x0125A,0x0125D), `Delta (0);
+  (0x01260,0x01288), `Delta (0);
+  (0x0128A,0x0128D), `Delta (0);
+  (0x01290,0x012B0), `Delta (0);
+  (0x012B2,0x012B5), `Delta (0);
+  (0x012B8,0x012BE), `Delta (0);
+  (0x012C0,0x012C0), `Abs (0x012C0);
+  (0x012C2,0x012C5), `Delta (0);
+  (0x012C8,0x012D6), `Delta (0);
+  (0x012D8,0x01310), `Delta (0);
+  (0x01312,0x01315), `Delta (0);
+  (0x01318,0x0135A), `Delta (0);
+  (0x01380,0x0138F), `Delta (0);
+  (0x01401,0x0166C), `Delta (0);
+  (0x0166F,0x0167F), `Delta (0);
+  (0x01681,0x0169A), `Delta (0);
+  (0x016A0,0x016EA), `Delta (0);
+  (0x016F1,0x016F8), `Delta (0);
+  (0x01700,0x0170C), `Delta (0);
+  (0x0170E,0x01711), `Delta (0);
+  (0x01720,0x01731), `Delta (0);
+  (0x01740,0x01751), `Delta (0);
+  (0x01760,0x0176C), `Delta (0);
+  (0x0176E,0x01770), `Delta (0);
+  (0x01780,0x017B3), `Delta (0);
+  (0x017DC,0x017DC), `Abs (0x017DC);
+  (0x01820,0x01842), `Delta (0);
+  (0x01844,0x01877), `Delta (0);
+  (0x01880,0x01884), `Delta (0);
+  (0x01887,0x018A8), `Delta (0);
+  (0x018AA,0x018AA), `Abs (0x018AA);
+  (0x018B0,0x018F5), `Delta (0);
+  (0x01900,0x0191E), `Delta (0);
+  (0x01950,0x0196D), `Delta (0);
+  (0x01970,0x01974), `Delta (0);
+  (0x01980,0x019AB), `Delta (0);
+  (0x019B0,0x019C9), `Delta (0);
+  (0x01A00,0x01A16), `Delta (0);
+  (0x01A20,0x01A54), `Delta (0);
+  (0x01B05,0x01B33), `Delta (0);
+  (0x01B45,0x01B4B), `Delta (0);
+  (0x01B83,0x01BA0), `Delta (0);
+  (0x01BAE,0x01BAF), `Delta (0);
+  (0x01BBA,0x01BE5), `Delta (0);
+  (0x01C00,0x01C23), `Delta (0);
+  (0x01C4D,0x01C4F), `Delta (0);
+  (0x01C5A,0x01C77), `Delta (0);
+  (0x01CE9,0x01CEC), `Delta (0);
+  (0x01CEE,0x01CF1), `Delta (0);
+  (0x01CF5,0x01CF6), `Delta (0);
+  (0x02135,0x02138), `Delta (0);
+  (0x02D30,0x02D67), `Delta (0);
+  (0x02D80,0x02D96), `Delta (0);
+  (0x02DA0,0x02DA6), `Delta (0);
+  (0x02DA8,0x02DAE), `Delta (0);
+  (0x02DB0,0x02DB6), `Delta (0);
+  (0x02DB8,0x02DBE), `Delta (0);
+  (0x02DC0,0x02DC6), `Delta (0);
+  (0x02DC8,0x02DCE), `Delta (0);
+  (0x02DD0,0x02DD6), `Delta (0);
+  (0x02DD8,0x02DDE), `Delta (0);
+  (0x03006,0x03006), `Abs (0x03006);
+  (0x0303C,0x0303C), `Abs (0x0303C);
+  (0x03041,0x03096), `Delta (0);
+  (0x0309F,0x0309F), `Abs (0x0309F);
+  (0x030A1,0x030FA), `Delta (0);
+  (0x030FF,0x030FF), `Abs (0x030FF);
+  (0x03105,0x0312D), `Delta (0);
+  (0x03131,0x0318E), `Delta (0);
+  (0x031A0,0x031BA), `Delta (0);
+  (0x031F0,0x031FF), `Delta (0);
+  (0x03400,0x04DB5), `Delta (0);
+  (0x04E00,0x09FD5), `Delta (0);
+  (0x0A000,0x0A014), `Delta (0);
+  (0x0A016,0x0A48C), `Delta (0);
+  (0x0A4D0,0x0A4F7), `Delta (0);
+  (0x0A500,0x0A60B), `Delta (0);
+  (0x0A610,0x0A61F), `Delta (0);
+  (0x0A62A,0x0A62B), `Delta (0);
+  (0x0A66E,0x0A66E), `Abs (0x0A66E);
+  (0x0A6A0,0x0A6E5), `Delta (0);
+  (0x0A78F,0x0A78F), `Abs (0x0A78F);
+  (0x0A7F7,0x0A7F7), `Abs (0x0A7F7);
+  (0x0A7FB,0x0A801), `Delta (0);
+  (0x0A803,0x0A805), `Delta (0);
+  (0x0A807,0x0A80A), `Delta (0);
+  (0x0A80C,0x0A822), `Delta (0);
+  (0x0A840,0x0A873), `Delta (0);
+  (0x0A882,0x0A8B3), `Delta (0);
+  (0x0A8F2,0x0A8F7), `Delta (0);
+  (0x0A8FB,0x0A8FB), `Abs (0x0A8FB);
+  (0x0A8FD,0x0A8FD), `Abs (0x0A8FD);
+  (0x0A90A,0x0A925), `Delta (0);
+  (0x0A930,0x0A946), `Delta (0);
+  (0x0A960,0x0A97C), `Delta (0);
+  (0x0A984,0x0A9B2), `Delta (0);
+  (0x0A9E0,0x0A9E4), `Delta (0);
+  (0x0A9E7,0x0A9EF), `Delta (0);
+  (0x0A9FA,0x0A9FE), `Delta (0);
+  (0x0AA00,0x0AA28), `Delta (0);
+  (0x0AA40,0x0AA42), `Delta (0);
+  (0x0AA44,0x0AA4B), `Delta (0);
+  (0x0AA60,0x0AA6F), `Delta (0);
+  (0x0AA71,0x0AA76), `Delta (0);
+  (0x0AA7A,0x0AA7A), `Abs (0x0AA7A);
+  (0x0AA7E,0x0AAAF), `Delta (0);
+  (0x0AAB1,0x0AAB1), `Abs (0x0AAB1);
+  (0x0AAB5,0x0AAB6), `Delta (0);
+  (0x0AAB9,0x0AABD), `Delta (0);
+  (0x0AAC0,0x0AAC0), `Abs (0x0AAC0);
+  (0x0AAC2,0x0AAC2), `Abs (0x0AAC2);
+  (0x0AADB,0x0AADC), `Delta (0);
+  (0x0AAE0,0x0AAEA), `Delta (0);
+  (0x0AAF2,0x0AAF2), `Abs (0x0AAF2);
+  (0x0AB01,0x0AB06), `Delta (0);
+  (0x0AB09,0x0AB0E), `Delta (0);
+  (0x0AB11,0x0AB16), `Delta (0);
+  (0x0AB20,0x0AB26), `Delta (0);
+  (0x0AB28,0x0AB2E), `Delta (0);
+  (0x0ABC0,0x0ABE2), `Delta (0);
+  (0x0AC00,0x0D7A3), `Delta (0);
+  (0x0D7B0,0x0D7C6), `Delta (0);
+  (0x0D7CB,0x0D7FB), `Delta (0);
+  (0x0F900,0x0FA6D), `Delta (0);
+  (0x0FA70,0x0FAD9), `Delta (0);
+  (0x0FB1D,0x0FB1D), `Abs (0x0FB1D);
+  (0x0FB1F,0x0FB28), `Delta (0);
+  (0x0FB2A,0x0FB36), `Delta (0);
+  (0x0FB38,0x0FB3C), `Delta (0);
+  (0x0FB3E,0x0FB3E), `Abs (0x0FB3E);
+  (0x0FB40,0x0FB41), `Delta (0);
+  (0x0FB43,0x0FB44), `Delta (0);
+  (0x0FB46,0x0FBB1), `Delta (0);
+  (0x0FBD3,0x0FD3D), `Delta (0);
+  (0x0FD50,0x0FD8F), `Delta (0);
+  (0x0FD92,0x0FDC7), `Delta (0);
+  (0x0FDF0,0x0FDFB), `Delta (0);
+  (0x0FE70,0x0FE74), `Delta (0);
+  (0x0FE76,0x0FEFC), `Delta (0);
+  (0x0FF66,0x0FF6F), `Delta (0);
+  (0x0FF71,0x0FF9D), `Delta (0);
+  (0x0FFA0,0x0FFBE), `Delta (0);
+  (0x0FFC2,0x0FFC7), `Delta (0);
+  (0x0FFCA,0x0FFCF), `Delta (0);
+  (0x0FFD2,0x0FFD7), `Delta (0);
+  (0x0FFDA,0x0FFDC), `Delta (0);
+  (0x10000,0x1000B), `Delta (0);
+  (0x1000D,0x10026), `Delta (0);
+  (0x10028,0x1003A), `Delta (0);
+  (0x1003C,0x1003D), `Delta (0);
+  (0x1003F,0x1004D), `Delta (0);
+  (0x10050,0x1005D), `Delta (0);
+  (0x10080,0x100FA), `Delta (0);
+  (0x10280,0x1029C), `Delta (0);
+  (0x102A0,0x102D0), `Delta (0);
+  (0x10300,0x1031F), `Delta (0);
+  (0x10330,0x10340), `Delta (0);
+  (0x10342,0x10349), `Delta (0);
+  (0x10350,0x10375), `Delta (0);
+  (0x10380,0x1039D), `Delta (0);
+  (0x103A0,0x103C3), `Delta (0);
+  (0x103C8,0x103CF), `Delta (0);
+  (0x10450,0x1049D), `Delta (0);
+  (0x10500,0x10527), `Delta (0);
+  (0x10530,0x10563), `Delta (0);
+  (0x10600,0x10736), `Delta (0);
+  (0x10740,0x10755), `Delta (0);
+  (0x10760,0x10767), `Delta (0);
+  (0x10800,0x10805), `Delta (0);
+  (0x10808,0x10808), `Abs (0x10808);
+  (0x1080A,0x10835), `Delta (0);
+  (0x10837,0x10838), `Delta (0);
+  (0x1083C,0x1083C), `Abs (0x1083C);
+  (0x1083F,0x10855), `Delta (0);
+  (0x10860,0x10876), `Delta (0);
+  (0x10880,0x1089E), `Delta (0);
+  (0x108E0,0x108F2), `Delta (0);
+  (0x108F4,0x108F5), `Delta (0);
+  (0x10900,0x10915), `Delta (0);
+  (0x10920,0x10939), `Delta (0);
+  (0x10980,0x109B7), `Delta (0);
+  (0x109BE,0x109BF), `Delta (0);
+  (0x10A00,0x10A00), `Abs (0x10A00);
+  (0x10A10,0x10A13), `Delta (0);
+  (0x10A15,0x10A17), `Delta (0);
+  (0x10A19,0x10A33), `Delta (0);
+  (0x10A60,0x10A7C), `Delta (0);
+  (0x10A80,0x10A9C), `Delta (0);
+  (0x10AC0,0x10AC7), `Delta (0);
+  (0x10AC9,0x10AE4), `Delta (0);
+  (0x10B00,0x10B35), `Delta (0);
+  (0x10B40,0x10B55), `Delta (0);
+  (0x10B60,0x10B72), `Delta (0);
+  (0x10B80,0x10B91), `Delta (0);
+  (0x10C00,0x10C48), `Delta (0);
+  (0x11003,0x11037), `Delta (0);
+  (0x11083,0x110AF), `Delta (0);
+  (0x110D0,0x110E8), `Delta (0);
+  (0x11103,0x11126), `Delta (0);
+  (0x11150,0x11172), `Delta (0);
+  (0x11176,0x11176), `Abs (0x11176);
+  (0x11183,0x111B2), `Delta (0);
+  (0x111C1,0x111C4), `Delta (0);
+  (0x111DA,0x111DA), `Abs (0x111DA);
+  (0x111DC,0x111DC), `Abs (0x111DC);
+  (0x11200,0x11211), `Delta (0);
+  (0x11213,0x1122B), `Delta (0);
+  (0x11280,0x11286), `Delta (0);
+  (0x11288,0x11288), `Abs (0x11288);
+  (0x1128A,0x1128D), `Delta (0);
+  (0x1128F,0x1129D), `Delta (0);
+  (0x1129F,0x112A8), `Delta (0);
+  (0x112B0,0x112DE), `Delta (0);
+  (0x11305,0x1130C), `Delta (0);
+  (0x1130F,0x11310), `Delta (0);
+  (0x11313,0x11328), `Delta (0);
+  (0x1132A,0x11330), `Delta (0);
+  (0x11332,0x11333), `Delta (0);
+  (0x11335,0x11339), `Delta (0);
+  (0x1133D,0x1133D), `Abs (0x1133D);
+  (0x11350,0x11350), `Abs (0x11350);
+  (0x1135D,0x11361), `Delta (0);
+  (0x11400,0x11434), `Delta (0);
+  (0x11447,0x1144A), `Delta (0);
+  (0x11480,0x114AF), `Delta (0);
+  (0x114C4,0x114C5), `Delta (0);
+  (0x114C7,0x114C7), `Abs (0x114C7);
+  (0x11580,0x115AE), `Delta (0);
+  (0x115D8,0x115DB), `Delta (0);
+  (0x11600,0x1162F), `Delta (0);
+  (0x11644,0x11644), `Abs (0x11644);
+  (0x11680,0x116AA), `Delta (0);
+  (0x11700,0x11719), `Delta (0);
+  (0x118FF,0x118FF), `Abs (0x118FF);
+  (0x11AC0,0x11AF8), `Delta (0);
+  (0x11C00,0x11C08), `Delta (0);
+  (0x11C0A,0x11C2E), `Delta (0);
+  (0x11C40,0x11C40), `Abs (0x11C40);
+  (0x11C72,0x11C8F), `Delta (0);
+  (0x12000,0x12399), `Delta (0);
+  (0x12480,0x12543), `Delta (0);
+  (0x13000,0x1342E), `Delta (0);
+  (0x14400,0x14646), `Delta (0);
+  (0x16800,0x16A38), `Delta (0);
+  (0x16A40,0x16A5E), `Delta (0);
+  (0x16AD0,0x16AED), `Delta (0);
+  (0x16B00,0x16B2F), `Delta (0);
+  (0x16B63,0x16B77), `Delta (0);
+  (0x16B7D,0x16B8F), `Delta (0);
+  (0x16F00,0x16F44), `Delta (0);
+  (0x16F50,0x16F50), `Abs (0x16F50);
+  (0x17000,0x187EC), `Delta (0);
+  (0x18800,0x18AF2), `Delta (0);
+  (0x1B000,0x1B001), `Delta (0);
+  (0x1BC00,0x1BC6A), `Delta (0);
+  (0x1BC70,0x1BC7C), `Delta (0);
+  (0x1BC80,0x1BC88), `Delta (0);
+  (0x1BC90,0x1BC99), `Delta (0);
+  (0x1E800,0x1E8C4), `Delta (0);
+  (0x1EE00,0x1EE03), `Delta (0);
+  (0x1EE05,0x1EE1F), `Delta (0);
+  (0x1EE21,0x1EE22), `Delta (0);
+  (0x1EE24,0x1EE24), `Abs (0x1EE24);
+  (0x1EE27,0x1EE27), `Abs (0x1EE27);
+  (0x1EE29,0x1EE32), `Delta (0);
+  (0x1EE34,0x1EE37), `Delta (0);
+  (0x1EE39,0x1EE39), `Abs (0x1EE39);
+  (0x1EE3B,0x1EE3B), `Abs (0x1EE3B);
+  (0x1EE42,0x1EE42), `Abs (0x1EE42);
+  (0x1EE47,0x1EE47), `Abs (0x1EE47);
+  (0x1EE49,0x1EE49), `Abs (0x1EE49);
+  (0x1EE4B,0x1EE4B), `Abs (0x1EE4B);
+  (0x1EE4D,0x1EE4F), `Delta (0);
+  (0x1EE51,0x1EE52), `Delta (0);
+  (0x1EE54,0x1EE54), `Abs (0x1EE54);
+  (0x1EE57,0x1EE57), `Abs (0x1EE57);
+  (0x1EE59,0x1EE59), `Abs (0x1EE59);
+  (0x1EE5B,0x1EE5B), `Abs (0x1EE5B);
+  (0x1EE5D,0x1EE5D), `Abs (0x1EE5D);
+  (0x1EE5F,0x1EE5F), `Abs (0x1EE5F);
+  (0x1EE61,0x1EE62), `Delta (0);
+  (0x1EE64,0x1EE64), `Abs (0x1EE64);
+  (0x1EE67,0x1EE6A), `Delta (0);
+  (0x1EE6C,0x1EE72), `Delta (0);
+  (0x1EE74,0x1EE77), `Delta (0);
+  (0x1EE79,0x1EE7C), `Delta (0);
+  (0x1EE7E,0x1EE7E), `Abs (0x1EE7E);
+  (0x1EE80,0x1EE89), `Delta (0);
+  (0x1EE8B,0x1EE9B), `Delta (0);
+  (0x1EEA1,0x1EEA3), `Delta (0);
+  (0x1EEA5,0x1EEA9), `Delta (0);
+  (0x1EEAB,0x1EEBB), `Delta (0);
+  (0x20000,0x2A6D6), `Delta (0);
+  (0x2A700,0x2B734), `Delta (0);
+  (0x2B740,0x2B81D), `Delta (0);
+  (0x2B820,0x2CEA1), `Delta (0);
+  (0x2F800,0x2FA1D), `Delta (0);
+  (0x0005F,0x0005F), `Abs (0x0005F);
+  (0x0203F,0x02040), `Delta (0);
+  (0x02054,0x02054), `Abs (0x02054);
+  (0x0FE33,0x0FE34), `Delta (0);
+  (0x0FE4D,0x0FE4F), `Delta (0);
+  (0x0FF3F,0x0FF3F), `Abs (0x0FF3F);
+  (0x0002D,0x0002D), `Abs (0x0002D);
+  (0x0058A,0x0058A), `Abs (0x0058A);
+  (0x005BE,0x005BE), `Abs (0x005BE);
+  (0x01400,0x01400), `Abs (0x01400);
+  (0x01806,0x01806), `Abs (0x01806);
+  (0x02010,0x02015), `Delta (0);
+  (0x02E17,0x02E17), `Abs (0x02E17);
+  (0x02E1A,0x02E1A), `Abs (0x02E1A);
+  (0x02E3A,0x02E3B), `Delta (0);
+  (0x02E40,0x02E40), `Abs (0x02E40);
+  (0x0301C,0x0301C), `Abs (0x0301C);
+  (0x03030,0x03030), `Abs (0x03030);
+  (0x030A0,0x030A0), `Abs (0x030A0);
+  (0x0FE31,0x0FE32), `Delta (0);
+  (0x0FE58,0x0FE58), `Abs (0x0FE58);
+  (0x0FE63,0x0FE63), `Abs (0x0FE63);
+  (0x0FF0D,0x0FF0D), `Abs (0x0FF0D);
+  (0x00028,0x00028), `Abs (0x00028);
+  (0x0005B,0x0005B), `Abs (0x0005B);
+  (0x0007B,0x0007B), `Abs (0x0007B);
+  (0x00F3A,0x00F3A), `Abs (0x00F3A);
+  (0x00F3C,0x00F3C), `Abs (0x00F3C);
+  (0x0169B,0x0169B), `Abs (0x0169B);
+  (0x0201A,0x0201A), `Abs (0x0201A);
+  (0x0201E,0x0201E), `Abs (0x0201E);
+  (0x02045,0x02045), `Abs (0x02045);
+  (0x0207D,0x0207D), `Abs (0x0207D);
+  (0x0208D,0x0208D), `Abs (0x0208D);
+  (0x02308,0x02308), `Abs (0x02308);
+  (0x0230A,0x0230A), `Abs (0x0230A);
+  (0x02329,0x02329), `Abs (0x02329);
+  (0x02768,0x02768), `Abs (0x02768);
+  (0x0276A,0x0276A), `Abs (0x0276A);
+  (0x0276C,0x0276C), `Abs (0x0276C);
+  (0x0276E,0x0276E), `Abs (0x0276E);
+  (0x02770,0x02770), `Abs (0x02770);
+  (0x02772,0x02772), `Abs (0x02772);
+  (0x02774,0x02774), `Abs (0x02774);
+  (0x027C5,0x027C5), `Abs (0x027C5);
+  (0x027E6,0x027E6), `Abs (0x027E6);
+  (0x027E8,0x027E8), `Abs (0x027E8);
+  (0x027EA,0x027EA), `Abs (0x027EA);
+  (0x027EC,0x027EC), `Abs (0x027EC);
+  (0x027EE,0x027EE), `Abs (0x027EE);
+  (0x02983,0x02983), `Abs (0x02983);
+  (0x02985,0x02985), `Abs (0x02985);
+  (0x02987,0x02987), `Abs (0x02987);
+  (0x02989,0x02989), `Abs (0x02989);
+  (0x0298B,0x0298B), `Abs (0x0298B);
+  (0x0298D,0x0298D), `Abs (0x0298D);
+  (0x0298F,0x0298F), `Abs (0x0298F);
+  (0x02991,0x02991), `Abs (0x02991);
+  (0x02993,0x02993), `Abs (0x02993);
+  (0x02995,0x02995), `Abs (0x02995);
+  (0x02997,0x02997), `Abs (0x02997);
+  (0x029D8,0x029D8), `Abs (0x029D8);
+  (0x029DA,0x029DA), `Abs (0x029DA);
+  (0x029FC,0x029FC), `Abs (0x029FC);
+  (0x02E22,0x02E22), `Abs (0x02E22);
+  (0x02E24,0x02E24), `Abs (0x02E24);
+  (0x02E26,0x02E26), `Abs (0x02E26);
+  (0x02E28,0x02E28), `Abs (0x02E28);
+  (0x02E42,0x02E42), `Abs (0x02E42);
+  (0x03008,0x03008), `Abs (0x03008);
+  (0x0300A,0x0300A), `Abs (0x0300A);
+  (0x0300C,0x0300C), `Abs (0x0300C);
+  (0x0300E,0x0300E), `Abs (0x0300E);
+  (0x03010,0x03010), `Abs (0x03010);
+  (0x03014,0x03014), `Abs (0x03014);
+  (0x03016,0x03016), `Abs (0x03016);
+  (0x03018,0x03018), `Abs (0x03018);
+  (0x0301A,0x0301A), `Abs (0x0301A);
+  (0x0301D,0x0301D), `Abs (0x0301D);
+  (0x0FD3F,0x0FD3F), `Abs (0x0FD3F);
+  (0x0FE17,0x0FE17), `Abs (0x0FE17);
+  (0x0FE35,0x0FE35), `Abs (0x0FE35);
+  (0x0FE37,0x0FE37), `Abs (0x0FE37);
+  (0x0FE39,0x0FE39), `Abs (0x0FE39);
+  (0x0FE3B,0x0FE3B), `Abs (0x0FE3B);
+  (0x0FE3D,0x0FE3D), `Abs (0x0FE3D);
+  (0x0FE3F,0x0FE3F), `Abs (0x0FE3F);
+  (0x0FE41,0x0FE41), `Abs (0x0FE41);
+  (0x0FE43,0x0FE43), `Abs (0x0FE43);
+  (0x0FE47,0x0FE47), `Abs (0x0FE47);
+  (0x0FE59,0x0FE59), `Abs (0x0FE59);
+  (0x0FE5B,0x0FE5B), `Abs (0x0FE5B);
+  (0x0FE5D,0x0FE5D), `Abs (0x0FE5D);
+  (0x0FF08,0x0FF08), `Abs (0x0FF08);
+  (0x0FF3B,0x0FF3B), `Abs (0x0FF3B);
+  (0x0FF5B,0x0FF5B), `Abs (0x0FF5B);
+  (0x0FF5F,0x0FF5F), `Abs (0x0FF5F);
+  (0x0FF62,0x0FF62), `Abs (0x0FF62);
+  (0x00029,0x00029), `Abs (0x00029);
+  (0x0005D,0x0005D), `Abs (0x0005D);
+  (0x0007D,0x0007D), `Abs (0x0007D);
+  (0x00F3B,0x00F3B), `Abs (0x00F3B);
+  (0x00F3D,0x00F3D), `Abs (0x00F3D);
+  (0x0169C,0x0169C), `Abs (0x0169C);
+  (0x02046,0x02046), `Abs (0x02046);
+  (0x0207E,0x0207E), `Abs (0x0207E);
+  (0x0208E,0x0208E), `Abs (0x0208E);
+  (0x02309,0x02309), `Abs (0x02309);
+  (0x0230B,0x0230B), `Abs (0x0230B);
+  (0x0232A,0x0232A), `Abs (0x0232A);
+  (0x02769,0x02769), `Abs (0x02769);
+  (0x0276B,0x0276B), `Abs (0x0276B);
+  (0x0276D,0x0276D), `Abs (0x0276D);
+  (0x0276F,0x0276F), `Abs (0x0276F);
+  (0x02771,0x02771), `Abs (0x02771);
+  (0x02773,0x02773), `Abs (0x02773);
+  (0x02775,0x02775), `Abs (0x02775);
+  (0x027C6,0x027C6), `Abs (0x027C6);
+  (0x027E7,0x027E7), `Abs (0x027E7);
+  (0x027E9,0x027E9), `Abs (0x027E9);
+  (0x027EB,0x027EB), `Abs (0x027EB);
+  (0x027ED,0x027ED), `Abs (0x027ED);
+  (0x027EF,0x027EF), `Abs (0x027EF);
+  (0x02984,0x02984), `Abs (0x02984);
+  (0x02986,0x02986), `Abs (0x02986);
+  (0x02988,0x02988), `Abs (0x02988);
+  (0x0298A,0x0298A), `Abs (0x0298A);
+  (0x0298C,0x0298C), `Abs (0x0298C);
+  (0x0298E,0x0298E), `Abs (0x0298E);
+  (0x02990,0x02990), `Abs (0x02990);
+  (0x02992,0x02992), `Abs (0x02992);
+  (0x02994,0x02994), `Abs (0x02994);
+  (0x02996,0x02996), `Abs (0x02996);
+  (0x02998,0x02998), `Abs (0x02998);
+  (0x029D9,0x029D9), `Abs (0x029D9);
+  (0x029DB,0x029DB), `Abs (0x029DB);
+  (0x029FD,0x029FD), `Abs (0x029FD);
+  (0x02E23,0x02E23), `Abs (0x02E23);
+  (0x02E25,0x02E25), `Abs (0x02E25);
+  (0x02E27,0x02E27), `Abs (0x02E27);
+  (0x02E29,0x02E29), `Abs (0x02E29);
+  (0x03009,0x03009), `Abs (0x03009);
+  (0x0300B,0x0300B), `Abs (0x0300B);
+  (0x0300D,0x0300D), `Abs (0x0300D);
+  (0x0300F,0x0300F), `Abs (0x0300F);
+  (0x03011,0x03011), `Abs (0x03011);
+  (0x03015,0x03015), `Abs (0x03015);
+  (0x03017,0x03017), `Abs (0x03017);
+  (0x03019,0x03019), `Abs (0x03019);
+  (0x0301B,0x0301B), `Abs (0x0301B);
+  (0x0301E,0x0301F), `Delta (0);
+  (0x0FD3E,0x0FD3E), `Abs (0x0FD3E);
+  (0x0FE18,0x0FE18), `Abs (0x0FE18);
+  (0x0FE36,0x0FE36), `Abs (0x0FE36);
+  (0x0FE38,0x0FE38), `Abs (0x0FE38);
+  (0x0FE3A,0x0FE3A), `Abs (0x0FE3A);
+  (0x0FE3C,0x0FE3C), `Abs (0x0FE3C);
+  (0x0FE3E,0x0FE3E), `Abs (0x0FE3E);
+  (0x0FE40,0x0FE40), `Abs (0x0FE40);
+  (0x0FE42,0x0FE42), `Abs (0x0FE42);
+  (0x0FE44,0x0FE44), `Abs (0x0FE44);
+  (0x0FE48,0x0FE48), `Abs (0x0FE48);
+  (0x0FE5A,0x0FE5A), `Abs (0x0FE5A);
+  (0x0FE5C,0x0FE5C), `Abs (0x0FE5C);
+  (0x0FE5E,0x0FE5E), `Abs (0x0FE5E);
+  (0x0FF09,0x0FF09), `Abs (0x0FF09);
+  (0x0FF3D,0x0FF3D), `Abs (0x0FF3D);
+  (0x0FF5D,0x0FF5D), `Abs (0x0FF5D);
+  (0x0FF60,0x0FF60), `Abs (0x0FF60);
+  (0x0FF63,0x0FF63), `Abs (0x0FF63);
+  (0x000AB,0x000AB), `Abs (0x000AB);
+  (0x02018,0x02018), `Abs (0x02018);
+  (0x0201B,0x0201C), `Delta (0);
+  (0x0201F,0x0201F), `Abs (0x0201F);
+  (0x02039,0x02039), `Abs (0x02039);
+  (0x02E02,0x02E02), `Abs (0x02E02);
+  (0x02E04,0x02E04), `Abs (0x02E04);
+  (0x02E09,0x02E09), `Abs (0x02E09);
+  (0x02E0C,0x02E0C), `Abs (0x02E0C);
+  (0x02E1C,0x02E1C), `Abs (0x02E1C);
+  (0x02E20,0x02E20), `Abs (0x02E20);
+  (0x000BB,0x000BB), `Abs (0x000BB);
+  (0x02019,0x02019), `Abs (0x02019);
+  (0x0201D,0x0201D), `Abs (0x0201D);
+  (0x0203A,0x0203A), `Abs (0x0203A);
+  (0x02E03,0x02E03), `Abs (0x02E03);
+  (0x02E05,0x02E05), `Abs (0x02E05);
+  (0x02E0A,0x02E0A), `Abs (0x02E0A);
+  (0x02E0D,0x02E0D), `Abs (0x02E0D);
+  (0x02E1D,0x02E1D), `Abs (0x02E1D);
+  (0x02E21,0x02E21), `Abs (0x02E21);
+  (0x00021,0x00023), `Delta (0);
+  (0x00025,0x00027), `Delta (0);
+  (0x0002A,0x0002A), `Abs (0x0002A);
+  (0x0002C,0x0002C), `Abs (0x0002C);
+  (0x0002E,0x0002F), `Delta (0);
+  (0x0003A,0x0003B), `Delta (0);
+  (0x0003F,0x00040), `Delta (0);
+  (0x0005C,0x0005C), `Abs (0x0005C);
+  (0x000A1,0x000A1), `Abs (0x000A1);
+  (0x000A7,0x000A7), `Abs (0x000A7);
+  (0x000B6,0x000B7), `Delta (0);
+  (0x000BF,0x000BF), `Abs (0x000BF);
+  (0x0037E,0x0037E), `Abs (0x0037E);
+  (0x00387,0x00387), `Abs (0x00387);
+  (0x0055A,0x0055F), `Delta (0);
+  (0x00589,0x00589), `Abs (0x00589);
+  (0x005C0,0x005C0), `Abs (0x005C0);
+  (0x005C3,0x005C3), `Abs (0x005C3);
+  (0x005C6,0x005C6), `Abs (0x005C6);
+  (0x005F3,0x005F4), `Delta (0);
+  (0x00609,0x0060A), `Delta (0);
+  (0x0060C,0x0060D), `Delta (0);
+  (0x0061B,0x0061B), `Abs (0x0061B);
+  (0x0061E,0x0061F), `Delta (0);
+  (0x0066A,0x0066D), `Delta (0);
+  (0x006D4,0x006D4), `Abs (0x006D4);
+  (0x00700,0x0070D), `Delta (0);
+  (0x007F7,0x007F9), `Delta (0);
+  (0x00830,0x0083E), `Delta (0);
+  (0x0085E,0x0085E), `Abs (0x0085E);
+  (0x00964,0x00965), `Delta (0);
+  (0x00970,0x00970), `Abs (0x00970);
+  (0x00AF0,0x00AF0), `Abs (0x00AF0);
+  (0x00DF4,0x00DF4), `Abs (0x00DF4);
+  (0x00E4F,0x00E4F), `Abs (0x00E4F);
+  (0x00E5A,0x00E5B), `Delta (0);
+  (0x00F04,0x00F12), `Delta (0);
+  (0x00F14,0x00F14), `Abs (0x00F14);
+  (0x00F85,0x00F85), `Abs (0x00F85);
+  (0x00FD0,0x00FD4), `Delta (0);
+  (0x00FD9,0x00FDA), `Delta (0);
+  (0x0104A,0x0104F), `Delta (0);
+  (0x010FB,0x010FB), `Abs (0x010FB);
+  (0x01360,0x01368), `Delta (0);
+  (0x0166D,0x0166E), `Delta (0);
+  (0x016EB,0x016ED), `Delta (0);
+  (0x01735,0x01736), `Delta (0);
+  (0x017D4,0x017D6), `Delta (0);
+  (0x017D8,0x017DA), `Delta (0);
+  (0x01800,0x01805), `Delta (0);
+  (0x01807,0x0180A), `Delta (0);
+  (0x01944,0x01945), `Delta (0);
+  (0x01A1E,0x01A1F), `Delta (0);
+  (0x01AA0,0x01AA6), `Delta (0);
+  (0x01AA8,0x01AAD), `Delta (0);
+  (0x01B5A,0x01B60), `Delta (0);
+  (0x01BFC,0x01BFF), `Delta (0);
+  (0x01C3B,0x01C3F), `Delta (0);
+  (0x01C7E,0x01C7F), `Delta (0);
+  (0x01CC0,0x01CC7), `Delta (0);
+  (0x01CD3,0x01CD3), `Abs (0x01CD3);
+  (0x02016,0x02017), `Delta (0);
+  (0x02020,0x02027), `Delta (0);
+  (0x02030,0x02038), `Delta (0);
+  (0x0203B,0x0203E), `Delta (0);
+  (0x02041,0x02043), `Delta (0);
+  (0x02047,0x02051), `Delta (0);
+  (0x02053,0x02053), `Abs (0x02053);
+  (0x02055,0x0205E), `Delta (0);
+  (0x02CF9,0x02CFC), `Delta (0);
+  (0x02CFE,0x02CFF), `Delta (0);
+  (0x02D70,0x02D70), `Abs (0x02D70);
+  (0x02E00,0x02E01), `Delta (0);
+  (0x02E06,0x02E08), `Delta (0);
+  (0x02E0B,0x02E0B), `Abs (0x02E0B);
+  (0x02E0E,0x02E16), `Delta (0);
+  (0x02E18,0x02E19), `Delta (0);
+  (0x02E1B,0x02E1B), `Abs (0x02E1B);
+  (0x02E1E,0x02E1F), `Delta (0);
+  (0x02E2A,0x02E2E), `Delta (0);
+  (0x02E30,0x02E39), `Delta (0);
+  (0x02E3C,0x02E3F), `Delta (0);
+  (0x02E41,0x02E41), `Abs (0x02E41);
+  (0x02E43,0x02E44), `Delta (0);
+  (0x03001,0x03003), `Delta (0);
+  (0x0303D,0x0303D), `Abs (0x0303D);
+  (0x030FB,0x030FB), `Abs (0x030FB);
+  (0x0A4FE,0x0A4FF), `Delta (0);
+  (0x0A60D,0x0A60F), `Delta (0);
+  (0x0A673,0x0A673), `Abs (0x0A673);
+  (0x0A67E,0x0A67E), `Abs (0x0A67E);
+  (0x0A6F2,0x0A6F7), `Delta (0);
+  (0x0A874,0x0A877), `Delta (0);
+  (0x0A8CE,0x0A8CF), `Delta (0);
+  (0x0A8F8,0x0A8FA), `Delta (0);
+  (0x0A8FC,0x0A8FC), `Abs (0x0A8FC);
+  (0x0A92E,0x0A92F), `Delta (0);
+  (0x0A95F,0x0A95F), `Abs (0x0A95F);
+  (0x0A9C1,0x0A9CD), `Delta (0);
+  (0x0A9DE,0x0A9DF), `Delta (0);
+  (0x0AA5C,0x0AA5F), `Delta (0);
+  (0x0AADE,0x0AADF), `Delta (0);
+  (0x0AAF0,0x0AAF1), `Delta (0);
+  (0x0ABEB,0x0ABEB), `Abs (0x0ABEB);
+  (0x0FE10,0x0FE16), `Delta (0);
+  (0x0FE19,0x0FE19), `Abs (0x0FE19);
+  (0x0FE30,0x0FE30), `Abs (0x0FE30);
+  (0x0FE45,0x0FE46), `Delta (0);
+  (0x0FE49,0x0FE4C), `Delta (0);
+  (0x0FE50,0x0FE52), `Delta (0);
+  (0x0FE54,0x0FE57), `Delta (0);
+  (0x0FE5F,0x0FE61), `Delta (0);
+  (0x0FE68,0x0FE68), `Abs (0x0FE68);
+  (0x0FE6A,0x0FE6B), `Delta (0);
+  (0x0FF01,0x0FF03), `Delta (0);
+  (0x0FF05,0x0FF07), `Delta (0);
+  (0x0FF0A,0x0FF0A), `Abs (0x0FF0A);
+  (0x0FF0C,0x0FF0C), `Abs (0x0FF0C);
+  (0x0FF0E,0x0FF0F), `Delta (0);
+  (0x0FF1A,0x0FF1B), `Delta (0);
+  (0x0FF1F,0x0FF20), `Delta (0);
+  (0x0FF3C,0x0FF3C), `Abs (0x0FF3C);
+  (0x0FF61,0x0FF61), `Abs (0x0FF61);
+  (0x0FF64,0x0FF65), `Delta (0);
+  (0x10100,0x10102), `Delta (0);
+  (0x1039F,0x1039F), `Abs (0x1039F);
+  (0x103D0,0x103D0), `Abs (0x103D0);
+  (0x1056F,0x1056F), `Abs (0x1056F);
+  (0x10857,0x10857), `Abs (0x10857);
+  (0x1091F,0x1091F), `Abs (0x1091F);
+  (0x1093F,0x1093F), `Abs (0x1093F);
+  (0x10A50,0x10A58), `Delta (0);
+  (0x10A7F,0x10A7F), `Abs (0x10A7F);
+  (0x10AF0,0x10AF6), `Delta (0);
+  (0x10B39,0x10B3F), `Delta (0);
+  (0x10B99,0x10B9C), `Delta (0);
+  (0x11047,0x1104D), `Delta (0);
+  (0x110BB,0x110BC), `Delta (0);
+  (0x110BE,0x110C1), `Delta (0);
+  (0x11140,0x11143), `Delta (0);
+  (0x11174,0x11175), `Delta (0);
+  (0x111C5,0x111C9), `Delta (0);
+  (0x111CD,0x111CD), `Abs (0x111CD);
+  (0x111DB,0x111DB), `Abs (0x111DB);
+  (0x111DD,0x111DF), `Delta (0);
+  (0x11238,0x1123D), `Delta (0);
+  (0x112A9,0x112A9), `Abs (0x112A9);
+  (0x1144B,0x1144F), `Delta (0);
+  (0x1145B,0x1145B), `Abs (0x1145B);
+  (0x1145D,0x1145D), `Abs (0x1145D);
+  (0x114C6,0x114C6), `Abs (0x114C6);
+  (0x115C1,0x115D7), `Delta (0);
+  (0x11641,0x11643), `Delta (0);
+  (0x11660,0x1166C), `Delta (0);
+  (0x1173C,0x1173E), `Delta (0);
+  (0x11C41,0x11C45), `Delta (0);
+  (0x11C70,0x11C71), `Delta (0);
+  (0x12470,0x12474), `Delta (0);
+  (0x16A6E,0x16A6F), `Delta (0);
+  (0x16AF5,0x16AF5), `Abs (0x16AF5);
+  (0x16B37,0x16B3B), `Delta (0);
+  (0x16B44,0x16B44), `Abs (0x16B44);
+  (0x1BC9F,0x1BC9F), `Abs (0x1BC9F);
+  (0x1DA87,0x1DA8B), `Delta (0);
+  (0x1E95E,0x1E95F), `Delta (0);
+  (0x0002B,0x0002B), `Abs (0x0002B);
+  (0x0003C,0x0003E), `Delta (0);
+  (0x0007C,0x0007C), `Abs (0x0007C);
+  (0x0007E,0x0007E), `Abs (0x0007E);
+  (0x000AC,0x000AC), `Abs (0x000AC);
+  (0x000B1,0x000B1), `Abs (0x000B1);
+  (0x000D7,0x000D7), `Abs (0x000D7);
+  (0x000F7,0x000F7), `Abs (0x000F7);
+  (0x003F6,0x003F6), `Abs (0x003F6);
+  (0x00606,0x00608), `Delta (0);
+  (0x02044,0x02044), `Abs (0x02044);
+  (0x02052,0x02052), `Abs (0x02052);
+  (0x0207A,0x0207C), `Delta (0);
+  (0x0208A,0x0208C), `Delta (0);
+  (0x02118,0x02118), `Abs (0x02118);
+  (0x02140,0x02144), `Delta (0);
+  (0x0214B,0x0214B), `Abs (0x0214B);
+  (0x02190,0x02194), `Delta (0);
+  (0x0219A,0x0219B), `Delta (0);
+  (0x021A0,0x021A0), `Abs (0x021A0);
+  (0x021A3,0x021A3), `Abs (0x021A3);
+  (0x021A6,0x021A6), `Abs (0x021A6);
+  (0x021AE,0x021AE), `Abs (0x021AE);
+  (0x021CE,0x021CF), `Delta (0);
+  (0x021D2,0x021D2), `Abs (0x021D2);
+  (0x021D4,0x021D4), `Abs (0x021D4);
+  (0x021F4,0x022FF), `Delta (0);
+  (0x02320,0x02321), `Delta (0);
+  (0x0237C,0x0237C), `Abs (0x0237C);
+  (0x0239B,0x023B3), `Delta (0);
+  (0x023DC,0x023E1), `Delta (0);
+  (0x025B7,0x025B7), `Abs (0x025B7);
+  (0x025C1,0x025C1), `Abs (0x025C1);
+  (0x025F8,0x025FF), `Delta (0);
+  (0x0266F,0x0266F), `Abs (0x0266F);
+  (0x027C0,0x027C4), `Delta (0);
+  (0x027C7,0x027E5), `Delta (0);
+  (0x027F0,0x027FF), `Delta (0);
+  (0x02900,0x02982), `Delta (0);
+  (0x02999,0x029D7), `Delta (0);
+  (0x029DC,0x029FB), `Delta (0);
+  (0x029FE,0x02AFF), `Delta (0);
+  (0x02B30,0x02B44), `Delta (0);
+  (0x02B47,0x02B4C), `Delta (0);
+  (0x0FB29,0x0FB29), `Abs (0x0FB29);
+  (0x0FE62,0x0FE62), `Abs (0x0FE62);
+  (0x0FE64,0x0FE66), `Delta (0);
+  (0x0FF0B,0x0FF0B), `Abs (0x0FF0B);
+  (0x0FF1C,0x0FF1E), `Delta (0);
+  (0x0FF5C,0x0FF5C), `Abs (0x0FF5C);
+  (0x0FF5E,0x0FF5E), `Abs (0x0FF5E);
+  (0x0FFE2,0x0FFE2), `Abs (0x0FFE2);
+  (0x0FFE9,0x0FFEC), `Delta (0);
+  (0x1D6C1,0x1D6C1), `Abs (0x1D6C1);
+  (0x1D6DB,0x1D6DB), `Abs (0x1D6DB);
+  (0x1D6FB,0x1D6FB), `Abs (0x1D6FB);
+  (0x1D715,0x1D715), `Abs (0x1D715);
+  (0x1D735,0x1D735), `Abs (0x1D735);
+  (0x1D74F,0x1D74F), `Abs (0x1D74F);
+  (0x1D76F,0x1D76F), `Abs (0x1D76F);
+  (0x1D789,0x1D789), `Abs (0x1D789);
+  (0x1D7A9,0x1D7A9), `Abs (0x1D7A9);
+  (0x1D7C3,0x1D7C3), `Abs (0x1D7C3);
+  (0x1EEF0,0x1EEF1), `Delta (0);
+  (0x00024,0x00024), `Abs (0x00024);
+  (0x000A2,0x000A5), `Delta (0);
+  (0x0058F,0x0058F), `Abs (0x0058F);
+  (0x0060B,0x0060B), `Abs (0x0060B);
+  (0x009F2,0x009F3), `Delta (0);
+  (0x009FB,0x009FB), `Abs (0x009FB);
+  (0x00AF1,0x00AF1), `Abs (0x00AF1);
+  (0x00BF9,0x00BF9), `Abs (0x00BF9);
+  (0x00E3F,0x00E3F), `Abs (0x00E3F);
+  (0x017DB,0x017DB), `Abs (0x017DB);
+  (0x020A0,0x020BE), `Delta (0);
+  (0x0A838,0x0A838), `Abs (0x0A838);
+  (0x0FDFC,0x0FDFC), `Abs (0x0FDFC);
+  (0x0FE69,0x0FE69), `Abs (0x0FE69);
+  (0x0FF04,0x0FF04), `Abs (0x0FF04);
+  (0x0FFE0,0x0FFE1), `Delta (0);
+  (0x0FFE5,0x0FFE6), `Delta (0);
+  (0x0005E,0x0005E), `Abs (0x0005E);
+  (0x00060,0x00060), `Abs (0x00060);
+  (0x000A8,0x000A8), `Abs (0x000A8);
+  (0x000AF,0x000AF), `Abs (0x000AF);
+  (0x000B4,0x000B4), `Abs (0x000B4);
+  (0x000B8,0x000B8), `Abs (0x000B8);
+  (0x002C2,0x002C5), `Delta (0);
+  (0x002D2,0x002DF), `Delta (0);
+  (0x002E5,0x002EB), `Delta (0);
+  (0x002ED,0x002ED), `Abs (0x002ED);
+  (0x002EF,0x002FF), `Delta (0);
+  (0x00375,0x00375), `Abs (0x00375);
+  (0x00384,0x00385), `Delta (0);
+  (0x01FBD,0x01FBD), `Abs (0x01FBD);
+  (0x01FBF,0x01FC1), `Delta (0);
+  (0x01FCD,0x01FCF), `Delta (0);
+  (0x01FDD,0x01FDF), `Delta (0);
+  (0x01FED,0x01FEF), `Delta (0);
+  (0x01FFD,0x01FFE), `Delta (0);
+  (0x0309B,0x0309C), `Delta (0);
+  (0x0A700,0x0A716), `Delta (0);
+  (0x0A720,0x0A721), `Delta (0);
+  (0x0A789,0x0A78A), `Delta (0);
+  (0x0AB5B,0x0AB5B), `Abs (0x0AB5B);
+  (0x0FBB2,0x0FBC1), `Delta (0);
+  (0x0FF3E,0x0FF3E), `Abs (0x0FF3E);
+  (0x0FF40,0x0FF40), `Abs (0x0FF40);
+  (0x0FFE3,0x0FFE3), `Abs (0x0FFE3);
+  (0x1F3FB,0x1F3FF), `Delta (0);
+  (0x000A6,0x000A6), `Abs (0x000A6);
+  (0x000A9,0x000A9), `Abs (0x000A9);
+  (0x000AE,0x000AE), `Abs (0x000AE);
+  (0x000B0,0x000B0), `Abs (0x000B0);
+  (0x00482,0x00482), `Abs (0x00482);
+  (0x0058D,0x0058E), `Delta (0);
+  (0x0060E,0x0060F), `Delta (0);
+  (0x006DE,0x006DE), `Abs (0x006DE);
+  (0x006E9,0x006E9), `Abs (0x006E9);
+  (0x006FD,0x006FE), `Delta (0);
+  (0x007F6,0x007F6), `Abs (0x007F6);
+  (0x009FA,0x009FA), `Abs (0x009FA);
+  (0x00B70,0x00B70), `Abs (0x00B70);
+  (0x00BF3,0x00BF8), `Delta (0);
+  (0x00BFA,0x00BFA), `Abs (0x00BFA);
+  (0x00C7F,0x00C7F), `Abs (0x00C7F);
+  (0x00D4F,0x00D4F), `Abs (0x00D4F);
+  (0x00D79,0x00D79), `Abs (0x00D79);
+  (0x00F01,0x00F03), `Delta (0);
+  (0x00F13,0x00F13), `Abs (0x00F13);
+  (0x00F15,0x00F17), `Delta (0);
+  (0x00F1A,0x00F1F), `Delta (0);
+  (0x00F34,0x00F34), `Abs (0x00F34);
+  (0x00F36,0x00F36), `Abs (0x00F36);
+  (0x00F38,0x00F38), `Abs (0x00F38);
+  (0x00FBE,0x00FC5), `Delta (0);
+  (0x00FC7,0x00FCC), `Delta (0);
+  (0x00FCE,0x00FCF), `Delta (0);
+  (0x00FD5,0x00FD8), `Delta (0);
+  (0x0109E,0x0109F), `Delta (0);
+  (0x01390,0x01399), `Delta (0);
+  (0x01940,0x01940), `Abs (0x01940);
+  (0x019DE,0x019FF), `Delta (0);
+  (0x01B61,0x01B6A), `Delta (0);
+  (0x01B74,0x01B7C), `Delta (0);
+  (0x02100,0x02101), `Delta (0);
+  (0x02103,0x02106), `Delta (0);
+  (0x02108,0x02109), `Delta (0);
+  (0x02114,0x02114), `Abs (0x02114);
+  (0x02116,0x02117), `Delta (0);
+  (0x0211E,0x02123), `Delta (0);
+  (0x02125,0x02125), `Abs (0x02125);
+  (0x02127,0x02127), `Abs (0x02127);
+  (0x02129,0x02129), `Abs (0x02129);
+  (0x0212E,0x0212E), `Abs (0x0212E);
+  (0x0213A,0x0213B), `Delta (0);
+  (0x0214A,0x0214A), `Abs (0x0214A);
+  (0x0214C,0x0214D), `Delta (0);
+  (0x0214F,0x0214F), `Abs (0x0214F);
+  (0x0218A,0x0218B), `Delta (0);
+  (0x02195,0x02199), `Delta (0);
+  (0x0219C,0x0219F), `Delta (0);
+  (0x021A1,0x021A2), `Delta (0);
+  (0x021A4,0x021A5), `Delta (0);
+  (0x021A7,0x021AD), `Delta (0);
+  (0x021AF,0x021CD), `Delta (0);
+  (0x021D0,0x021D1), `Delta (0);
+  (0x021D3,0x021D3), `Abs (0x021D3);
+  (0x021D5,0x021F3), `Delta (0);
+  (0x02300,0x02307), `Delta (0);
+  (0x0230C,0x0231F), `Delta (0);
+  (0x02322,0x02328), `Delta (0);
+  (0x0232B,0x0237B), `Delta (0);
+  (0x0237D,0x0239A), `Delta (0);
+  (0x023B4,0x023DB), `Delta (0);
+  (0x023E2,0x023FE), `Delta (0);
+  (0x02400,0x02426), `Delta (0);
+  (0x02440,0x0244A), `Delta (0);
+  (0x0249C,0x024B5), `Delta (0);
+  (0x024B6,0x024CF), `Delta (26);
+  (0x024D0,0x024E9), `Delta (0);
+  (0x02500,0x025B6), `Delta (0);
+  (0x025B8,0x025C0), `Delta (0);
+  (0x025C2,0x025F7), `Delta (0);
+  (0x02600,0x0266E), `Delta (0);
+  (0x02670,0x02767), `Delta (0);
+  (0x02794,0x027BF), `Delta (0);
+  (0x02800,0x028FF), `Delta (0);
+  (0x02B00,0x02B2F), `Delta (0);
+  (0x02B45,0x02B46), `Delta (0);
+  (0x02B4D,0x02B73), `Delta (0);
+  (0x02B76,0x02B95), `Delta (0);
+  (0x02B98,0x02BB9), `Delta (0);
+  (0x02BBD,0x02BC8), `Delta (0);
+  (0x02BCA,0x02BD1), `Delta (0);
+  (0x02BEC,0x02BEF), `Delta (0);
+  (0x02CE5,0x02CEA), `Delta (0);
+  (0x02E80,0x02E99), `Delta (0);
+  (0x02E9B,0x02EF3), `Delta (0);
+  (0x02F00,0x02FD5), `Delta (0);
+  (0x02FF0,0x02FFB), `Delta (0);
+  (0x03004,0x03004), `Abs (0x03004);
+  (0x03012,0x03013), `Delta (0);
+  (0x03020,0x03020), `Abs (0x03020);
+  (0x03036,0x03037), `Delta (0);
+  (0x0303E,0x0303F), `Delta (0);
+  (0x03190,0x03191), `Delta (0);
+  (0x03196,0x0319F), `Delta (0);
+  (0x031C0,0x031E3), `Delta (0);
+  (0x03200,0x0321E), `Delta (0);
+  (0x0322A,0x03247), `Delta (0);
+  (0x03250,0x03250), `Abs (0x03250);
+  (0x03260,0x0327F), `Delta (0);
+  (0x0328A,0x032B0), `Delta (0);
+  (0x032C0,0x032FE), `Delta (0);
+  (0x03300,0x033FF), `Delta (0);
+  (0x04DC0,0x04DFF), `Delta (0);
+  (0x0A490,0x0A4C6), `Delta (0);
+  (0x0A828,0x0A82B), `Delta (0);
+  (0x0A836,0x0A837), `Delta (0);
+  (0x0A839,0x0A839), `Abs (0x0A839);
+  (0x0AA77,0x0AA79), `Delta (0);
+  (0x0FDFD,0x0FDFD), `Abs (0x0FDFD);
+  (0x0FFE4,0x0FFE4), `Abs (0x0FFE4);
+  (0x0FFE8,0x0FFE8), `Abs (0x0FFE8);
+  (0x0FFED,0x0FFEE), `Delta (0);
+  (0x0FFFC,0x0FFFD), `Delta (0);
+  (0x10137,0x1013F), `Delta (0);
+  (0x10179,0x10189), `Delta (0);
+  (0x1018C,0x1018E), `Delta (0);
+  (0x10190,0x1019B), `Delta (0);
+  (0x101A0,0x101A0), `Abs (0x101A0);
+  (0x101D0,0x101FC), `Delta (0);
+  (0x10877,0x10878), `Delta (0);
+  (0x10AC8,0x10AC8), `Abs (0x10AC8);
+  (0x1173F,0x1173F), `Abs (0x1173F);
+  (0x16B3C,0x16B3F), `Delta (0);
+  (0x16B45,0x16B45), `Abs (0x16B45);
+  (0x1BC9C,0x1BC9C), `Abs (0x1BC9C);
+  (0x1D000,0x1D0F5), `Delta (0);
+  (0x1D100,0x1D126), `Delta (0);
+  (0x1D129,0x1D164), `Delta (0);
+  (0x1D16A,0x1D16C), `Delta (0);
+  (0x1D183,0x1D184), `Delta (0);
+  (0x1D18C,0x1D1A9), `Delta (0);
+  (0x1D1AE,0x1D1E8), `Delta (0);
+  (0x1D200,0x1D241), `Delta (0);
+  (0x1D245,0x1D245), `Abs (0x1D245);
+  (0x1D300,0x1D356), `Delta (0);
+  (0x1D800,0x1D9FF), `Delta (0);
+  (0x1DA37,0x1DA3A), `Delta (0);
+  (0x1DA6D,0x1DA74), `Delta (0);
+  (0x1DA76,0x1DA83), `Delta (0);
+  (0x1DA85,0x1DA86), `Delta (0);
+  (0x1F000,0x1F02B), `Delta (0);
+  (0x1F030,0x1F093), `Delta (0);
+  (0x1F0A0,0x1F0AE), `Delta (0);
+  (0x1F0B1,0x1F0BF), `Delta (0);
+  (0x1F0C1,0x1F0CF), `Delta (0);
+  (0x1F0D1,0x1F0F5), `Delta (0);
+  (0x1F110,0x1F12E), `Delta (0);
+  (0x1F130,0x1F16B), `Delta (0);
+  (0x1F170,0x1F1AC), `Delta (0);
+  (0x1F1E6,0x1F202), `Delta (0);
+  (0x1F210,0x1F23B), `Delta (0);
+  (0x1F240,0x1F248), `Delta (0);
+  (0x1F250,0x1F251), `Delta (0);
+  (0x1F300,0x1F3FA), `Delta (0);
+  (0x1F400,0x1F6D2), `Delta (0);
+  (0x1F6E0,0x1F6EC), `Delta (0);
+  (0x1F6F0,0x1F6F6), `Delta (0);
+  (0x1F700,0x1F773), `Delta (0);
+  (0x1F780,0x1F7D4), `Delta (0);
+  (0x1F800,0x1F80B), `Delta (0);
+  (0x1F810,0x1F847), `Delta (0);
+  (0x1F850,0x1F859), `Delta (0);
+  (0x1F860,0x1F887), `Delta (0);
+  (0x1F890,0x1F8AD), `Delta (0);
+  (0x1F910,0x1F91E), `Delta (0);
+  (0x1F920,0x1F927), `Delta (0);
+  (0x1F930,0x1F930), `Abs (0x1F930);
+  (0x1F933,0x1F93E), `Delta (0);
+  (0x1F940,0x1F94B), `Delta (0);
+  (0x1F950,0x1F95E), `Delta (0);
+  (0x1F980,0x1F991), `Delta (0)
+];;
diff --git a/lib/util.ml b/lib/util.ml
index 009dfbe1c..9fb0d48ee 100644
--- a/lib/util.ml
+++ b/lib/util.ml
@@ -87,13 +87,17 @@ let matrix_transpose mat =
 
 let identity x = x
 
-(** Function composition: the mathematical [∘] operator.
+(** Left-to-right function composition:
+    
+    [f1 %> f2] is [fun x -> f2 (f1 x)].
 
-    So [g % f] is a synonym for [fun x -> g (f x)].
+    [f1 %> f2 %> f3] is [fun x -> f3 (f2 (f1 x))].
 
-    Also because [%] is right-associative, [h % g % f] means [fun x -> h (g (f x))].
- *)
-let (%) f g x = f (g x)
+    [f1 %> f2 %> f3 %> f4] is [fun x -> f4 (f3 (f2 (f1 x)))]
+
+    etc.
+*)
+let (%>) f g x = g (f x)
 
 let const x _ = x
 
diff --git a/lib/util.mli b/lib/util.mli
index 6bed7e355..cf8041a0d 100644
--- a/lib/util.mli
+++ b/lib/util.mli
@@ -84,13 +84,17 @@ val matrix_transpose : 'a list list -> 'a list list
 
 val identity : 'a -> 'a
 
-(** Function composition: the mathematical [∘] operator.
+(** Left-to-right function composition:
+    
+    [f1 %> f2] is [fun x -> f2 (f1 x)].
 
-    So [g % f] is a synonym for [fun x -> g (f x)].
+    [f1 %> f2 %> f3] is [fun x -> f3 (f2 (f1 x))].
 
-    Also because [%] is right-associative, [h % g % f] means [fun x -> h (g (f x))].
+    [f1 %> f2 %> f3 %> f4] is [fun x -> f4 (f3 (f2 (f1 x)))]
+
+    etc.
 *)
-val (%) : ('a -> 'b) -> ('c -> 'a) -> 'c -> 'b
+val ( %> ) : ('a -> 'b) -> ('b -> 'c) -> 'a -> 'c
 
 val const : 'a -> 'b -> 'a
 val iterate : ('a -> 'a) -> int -> 'a -> 'a
diff --git a/library/declare.ml b/library/declare.ml
index b0df32b8d..31c9c24bc 100644
--- a/library/declare.ml
+++ b/library/declare.ml
@@ -9,7 +9,7 @@
 (** This module is about the low-level declaration of logical objects *)
 
 open Pp
-open Errors
+open CErrors
 open Util
 open Names
 open Libnames
@@ -149,7 +149,7 @@ let cache_constant ((sp,kn), obj) =
       obj.cst_was_seff <- false;  
       if Global.exists_objlabel (Label.of_id (basename sp))
       then constant_of_kn kn
-      else Errors.anomaly Pp.(str"Ex seff not found: " ++ Id.print(basename sp))
+      else CErrors.anomaly Pp.(str"Ex seff not found: " ++ Id.print(basename sp))
     end else
       let () = check_exists sp in
       let kn', exported = Global.add_constant dir id obj.cst_decl in
@@ -353,7 +353,8 @@ let dummy_inductive_entry (_,m) = ([],{
   mind_entry_inds = List.map dummy_one_inductive_entry m.mind_entry_inds;
   mind_entry_polymorphic = false;
   mind_entry_universes = Univ.UContext.empty;
-  mind_entry_private = None })
+  mind_entry_private = None;
+})
 
 type inductive_obj = Dischargedhypsmap.discharged_hyps * mutual_inductive_entry
 
@@ -433,20 +434,37 @@ let assumption_message id =
 
 (** Global universe names, in a different summary *)
 
+type universe_context_decl = polymorphic * Univ.universe_context_set
+
+let cache_universe_context (p, ctx) =
+  Global.push_context_set p ctx;
+  if p then Lib.add_section_context ctx
+
+let input_universe_context : universe_context_decl -> Libobject.obj =
+  declare_object
+    { (default_object "Global universe context state") with
+      cache_function = (fun (na, pi) -> cache_universe_context pi);
+      load_function = (fun _ (_, pi) -> cache_universe_context pi);
+      discharge_function = (fun (_, (p, _ as x)) -> if p then None else Some x);
+      classify_function = (fun a -> Keep a) }
+
+let declare_universe_context poly ctx =
+  Lib.add_anonymous_leaf (input_universe_context (poly, ctx))
+
 (* Discharged or not *)
 type universe_decl = polymorphic * (Id.t * Univ.universe_level) list
 
 let cache_universes (p, l) =
-  let glob = Universes.global_universe_names () in
+  let glob = Global.global_universe_names () in
   let glob', ctx =
     List.fold_left (fun ((idl,lid),ctx) (id, lev) ->
-		    ((Idmap.add id lev idl, Univ.LMap.add lev id lid),
-		     Univ.ContextSet.add_universe lev ctx))
+        ((Idmap.add id (p, lev) idl,
+          Univ.LMap.add lev id lid),
+         Univ.ContextSet.add_universe lev ctx))
       (glob, Univ.ContextSet.empty) l
   in
-    Global.push_context_set p ctx;
-    if p then Lib.add_section_context ctx;
-    Universes.set_global_universe_names glob'
+  cache_universe_context (p, ctx);
+  Global.set_global_universe_names glob'
 
 let input_universes : universe_decl -> Libobject.obj =
   declare_object
@@ -457,6 +475,12 @@ let input_universes : universe_decl -> Libobject.obj =
       classify_function = (fun a -> Keep a) }
 
 let do_universe poly l =
+  let in_section = Lib.sections_are_opened () in
+  let () =
+    if poly && not in_section then
+      user_err ~hdr:"Constraint"
+                   (str"Cannot declare polymorphic universes outside sections")
+  in
   let l =
     List.map (fun (l, id) ->
 	      let lev = Universes.new_univ_level (Global.current_dirpath ()) in
@@ -467,8 +491,10 @@ let do_universe poly l =
 type constraint_decl = polymorphic * Univ.constraints
 
 let cache_constraints (na, (p, c)) =
-  Global.add_constraints c;
-  if p then Lib.add_section_context (Univ.ContextSet.add_constraints c Univ.ContextSet.empty)
+  let ctx =
+    Univ.ContextSet.add_constraints c
+      Univ.ContextSet.empty (* No declared universes here, just constraints *)
+  in cache_universe_context (p,ctx)
 
 let discharge_constraints (_, (p, c as a)) =
   if p then None else Some a
@@ -483,16 +509,40 @@ let input_constraints : constraint_decl -> Libobject.obj =
       classify_function = (fun a -> Keep a) }
 
 let do_constraint poly l =
-  let u_of_id =
-    let names, _ = Universes.global_universe_names () in
-      fun (loc, id) ->
-	try Idmap.find id names
-	with Not_found ->
-	  user_err_loc (loc, "Constraint", str "Undeclared universe " ++ pr_id id)
+  let open Misctypes in
+  let u_of_id x =
+    match x with
+    | GProp -> Loc.dummy_loc, (false, Univ.Level.prop)
+    | GSet -> Loc.dummy_loc, (false, Univ.Level.set)
+    | GType None ->
+       user_err ~hdr:"Constraint"
+                     (str "Cannot declare constraints on anonymous universes")
+    | GType (Some (loc, id)) ->
+       let id = Id.of_string id in
+       let names, _ = Global.global_universe_names () in
+       try loc, Idmap.find id names
+       with Not_found ->
+         user_err ~loc ~hdr:"Constraint" (str "Undeclared universe " ++ pr_id id)
+  in
+  let in_section = Lib.sections_are_opened () in
+  let () =
+    if poly && not in_section then
+      user_err ~hdr:"Constraint"
+                    (str"Cannot declare polymorphic constraints outside sections")
+  in
+  let check_poly loc p loc' p' =
+    if poly then ()
+    else if p || p' then
+      let loc = if p then loc else loc' in
+      user_err ~loc ~hdr:"Constraint"
+                    (str "Cannot declare a global constraint on " ++
+                    str "a polymorphic universe, use "
+                    ++ str "Polymorphic Constraint instead")
   in
   let constraints = List.fold_left (fun acc (l, d, r) ->
-    let lu = u_of_id l and ru = u_of_id r in
-      Univ.Constraint.add (lu, d, ru) acc)
+     let ploc, (p, lu) = u_of_id l and rloc, (p', ru) = u_of_id r in
+     check_poly ploc p rloc p';
+     Univ.Constraint.add (lu, d, ru) acc)
     Univ.Constraint.empty l
   in
     Lib.add_anonymous_leaf (input_constraints (poly, constraints))
diff --git a/library/declare.mli b/library/declare.mli
index 8dd24d278..f70d594d7 100644
--- a/library/declare.mli
+++ b/library/declare.mli
@@ -34,14 +34,6 @@ val declare_variable : variable -> variable_declaration -> object_name
 
 type constant_declaration = Safe_typing.private_constants 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 
-
-  internal specify if the constant has been created by the kernel or by the
-  user, and in the former case, if its errors should be silent
-   
-   *)
 type internal_flag =
   | UserAutomaticRequest
   | InternalTacticRequest
@@ -53,6 +45,12 @@ val definition_entry : ?fix_exn:Future.fix_exn ->
   ?poly:polymorphic -> ?univs:Univ.universe_context ->
   ?eff:Safe_typing.private_constants -> constr -> Safe_typing.private_constants definition_entry
 
+(** [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
+
+  internal specify if the constant has been created by the kernel or by the
+  user, and in the former case, if its errors should be silent *)
 val declare_constant :
  ?internal:internal_flag -> ?local:bool -> Id.t -> ?export_seff:bool -> constant_declaration -> constant
 
@@ -89,7 +87,11 @@ val exists_name : Id.t -> bool
 
 
 
-(** Global universe names and constraints *)
+(** Global universe contexts, names and constraints *)
+
+val declare_universe_context : polymorphic -> Univ.universe_context_set -> unit
 
 val do_universe : polymorphic -> Id.t Loc.located list -> unit
-val do_constraint : polymorphic -> (Id.t Loc.located * Univ.constraint_type * Id.t Loc.located) list -> unit
+val do_constraint : polymorphic ->
+  (Misctypes.glob_level * Univ.constraint_type * Misctypes.glob_level) list ->
+  unit
diff --git a/library/declaremods.ml b/library/declaremods.ml
index f3f734aa0..3a263b1e1 100644
--- a/library/declaremods.ml
+++ b/library/declaremods.ml
@@ -7,7 +7,7 @@
 (************************************************************************)
 
 open Pp
-open Errors
+open CErrors
 open Util
 open Names
 open Declarations
@@ -166,13 +166,13 @@ let consistency_checks exists dir dirinfo =
     let globref =
       try Nametab.locate_dir (qualid_of_dirpath dir)
       with Not_found ->
-        errorlabstrm "consistency_checks"
+        user_err ~hdr:"consistency_checks"
           (pr_dirpath dir ++ str " should already exist!")
     in
     assert (eq_global_dir_reference globref dirinfo)
   else
     if Nametab.exists_dir dir then
-      errorlabstrm "consistency_checks"
+      user_err ~hdr:"consistency_checks"
         (pr_dirpath dir ++ str " already exists")
 
 let compute_visibility exists i =
@@ -822,7 +822,7 @@ let protect_summaries f =
   try f fs
   with reraise ->
     (* Something wrong: undo the whole process *)
-    let reraise = Errors.push reraise in
+    let reraise = CErrors.push reraise in
     let () = Summary.unfreeze_summaries fs in
     iraise reraise
 
@@ -897,7 +897,13 @@ let start_library dir =
   Lib.start_compilation dir mp;
   Lib.add_frozen_state ()
 
+let end_library_hook = ref ignore
+let append_end_library_hook f =
+  let old_f = !end_library_hook in
+  end_library_hook := fun () -> old_f(); f ()
+
 let end_library ?except dir =
+  !end_library_hook();
   let oname = Lib.end_compilation_checks dir in
   let mp,cenv,ast = Global.export ?except dir in
   let prefix, lib_stack = Lib.end_compilation oname in
diff --git a/library/declaremods.mli b/library/declaremods.mli
index 2b440c087..3917fe8d6 100644
--- a/library/declaremods.mli
+++ b/library/declaremods.mli
@@ -90,6 +90,9 @@ val end_library :
   ?except:Future.UUIDSet.t -> library_name ->
     Safe_typing.compiled_library * library_objects * Safe_typing.native_library
 
+(** append a function to be executed at end_library *)
+val append_end_library_hook : (unit -> unit) -> unit
+
 (** [really_import_module mp] opens the module [mp] (in a Caml sense).
    It modifies Nametab and performs the [open_object] function for
    every object of the module. Raises [Not_found] when [mp] is unknown
diff --git a/library/decls.ml b/library/decls.ml
index 6e21880f1..2952c258a 100644
--- a/library/decls.ml
+++ b/library/decls.ml
@@ -14,6 +14,8 @@ open Names
 open Decl_kinds
 open Libnames
 
+module NamedDecl = Context.Named.Declaration
+
 (** Datas associated to section variables and local definitions *)
 
 type variable_data =
@@ -46,20 +48,18 @@ let constant_kind kn = Cmap.find kn !csttab
 
 (** Miscellaneous functions. *)
 
-open Context.Named.Declaration
-
 let initialize_named_context_for_proof () =
   let sign = Global.named_context () in
   List.fold_right
     (fun d signv ->
-      let id = get_id d in
-      let d = if variable_opacity id then LocalAssum (id, get_type d) else d in
+      let id = NamedDecl.get_id d in
+      let d = if variable_opacity id then NamedDecl.LocalAssum (id, NamedDecl.get_type d) else d in
       Environ.push_named_context_val d signv) sign Environ.empty_named_context_val
 
 let last_section_hyps dir =
   Context.Named.fold_outside
     (fun d sec_ids ->
-      let id = get_id d in
+      let id = NamedDecl.get_id d in
       try if DirPath.equal dir (variable_path id) then id::sec_ids else sec_ids
       with Not_found -> sec_ids)
     (Environ.named_context (Global.env()))
diff --git a/library/global.ml b/library/global.ml
index 2398e92b0..5fa710b36 100644
--- a/library/global.ml
+++ b/library/global.ml
@@ -8,6 +8,7 @@
 
 open Names
 open Environ
+open Decl_kinds
 
 (** We introduce here the global environment of the system,
     and we declare it as a synchronized table. *)
@@ -42,7 +43,7 @@ let () =
 
 let assert_not_parsing () =
   if !Flags.we_are_parsing then
-    Errors.anomaly (
+    CErrors.anomaly (
       Pp.strbrk"The global environment cannot be accessed during parsing")
 
 let safe_env () = assert_not_parsing(); !global_env
@@ -84,6 +85,7 @@ let push_context_set b c = globalize0 (Safe_typing.push_context_set b c)
 let push_context b c = globalize0 (Safe_typing.push_context b c)
 
 let set_engagement c = globalize0 (Safe_typing.set_engagement c)
+let set_typing_flags c = globalize0 (Safe_typing.set_typing_flags c)
 let add_constant dir id d = globalize (Safe_typing.add_constant dir (i2l id) d)
 let add_mind dir id mie = globalize (Safe_typing.add_mind dir (i2l id) mie)
 let add_modtype id me inl = globalize (Safe_typing.add_modtype (i2l id) me inl)
@@ -228,6 +230,17 @@ let universes_of_global env r =
 let universes_of_global gr = 
   universes_of_global (env ()) gr
 
+(** Global universe names *)
+type universe_names = 
+  (polymorphic * Univ.universe_level) Idmap.t * Id.t Univ.LMap.t
+
+let global_universes =
+  Summary.ref ~name:"Global universe names"
+  ((Idmap.empty, Univ.LMap.empty) : universe_names)
+
+let global_universe_names () = !global_universes
+let set_global_universe_names s = global_universes := s
+
 let is_polymorphic r = 
   let env = env() in 
   match r with
@@ -244,6 +257,14 @@ let is_template_polymorphic r =
   | IndRef ind -> Environ.template_polymorphic_ind ind env
   | ConstructRef cstr -> Environ.template_polymorphic_ind (inductive_of_constructor cstr) env
 
+let is_type_in_type r =
+  let env = env() in
+  match r with
+  | VarRef id -> false
+  | ConstRef c -> Environ.type_in_type_constant c env
+  | IndRef ind -> Environ.type_in_type_ind ind env
+  | ConstructRef cstr -> Environ.type_in_type_ind (inductive_of_constructor cstr) env
+
 let current_dirpath () = 
   Safe_typing.current_dirpath (safe_env ())
 
diff --git a/library/global.mli b/library/global.mli
index bf653307c..a4a38ce84 100644
--- a/library/global.mli
+++ b/library/global.mli
@@ -27,6 +27,7 @@ val named_context : unit -> Context.Named.t
 
 (** Changing the (im)predicativity of the system *)
 val set_engagement : Declarations.engagement -> unit
+val set_typing_flags : Declarations.typing_flags -> unit
 
 (** Variables, Local definitions, constants, inductive types *)
 
@@ -95,6 +96,13 @@ val constraints_of_constant_body :
 val universes_of_constant_body :
   Declarations.constant_body -> Univ.universe_context
 
+(** Global universe name <-> level mapping *)
+type universe_names = 
+  (Decl_kinds.polymorphic * Univ.universe_level) Idmap.t * Id.t Univ.LMap.t
+
+val global_universe_names : unit -> universe_names
+val set_global_universe_names : universe_names -> unit
+
 (** {6 Compiled libraries } *)
 
 val start_library : DirPath.t -> module_path
@@ -116,6 +124,7 @@ val is_joined_environment : unit -> bool
 
 val is_polymorphic : Globnames.global_reference -> bool
 val is_template_polymorphic : Globnames.global_reference -> bool
+val is_type_in_type : Globnames.global_reference -> bool
 
 val type_of_global_in_context : Environ.env -> 
   Globnames.global_reference -> Constr.types Univ.in_universe_context
diff --git a/library/globnames.ml b/library/globnames.ml
index bec463ecf..a78f5f13a 100644
--- a/library/globnames.ml
+++ b/library/globnames.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-open Errors
+open CErrors
 open Names
 open Term
 open Mod_subst
diff --git a/library/goptions.ml b/library/goptions.ml
index 4aa3a2a21..1c08b9539 100644
--- a/library/goptions.ml
+++ b/library/goptions.ml
@@ -9,7 +9,7 @@
 (* This module manages customization parameters at the vernacular level     *)
 
 open Pp
-open Errors
+open CErrors
 open Util
 open Libobject
 open Libnames
@@ -36,7 +36,7 @@ type option_state = {
 let nickname table = String.concat " " table
 
 let error_undeclared_key key =
-  errorlabstrm "Goptions" (str (nickname key) ++ str ": no table or option of this type")
+  user_err ~hdr:"Goptions" (str (nickname key) ++ str ": no table or option of this type")
 
 (****************************************************************************)
 (* 1- Tables                                                                *)
@@ -208,6 +208,10 @@ type 'a option_sig = {
   optread  : unit -> 'a;
   optwrite : 'a -> unit }
 
+type option_locality = OptLocal | OptDefault | OptGlobal
+
+type option_mod = OptSet | OptAppend
+
 module OptionOrd =
 struct
   type t = option_name
@@ -233,52 +237,57 @@ with Not_found ->
 open Libobject
 open Lib
 
-let declare_option cast uncast
+let warn_deprecated_option =
+  CWarnings.create ~name:"deprecated-option" ~category:"deprecated"
+         (fun key -> str "Option" ++ spc () ++ str (nickname key) ++
+                       strbrk " is deprecated")
+
+let get_locality = function
+  | Some true -> OptLocal
+  | Some false -> OptGlobal
+  | None -> OptDefault
+
+let declare_option cast uncast append ?(preprocess = fun x -> x)
   { optsync=sync; optdepr=depr; optname=name; optkey=key; optread=read; optwrite=write } =
   check_key key;
   let default = read() in
-  (* spiwack: I use two spaces in the nicknames of "local" and "global" objects.
-      That way I shouldn't collide with [nickname key] for any [key]. As [key]-s are
-       lists of strings *without* spaces. *)
-  let (write,lwrite,gwrite) = if sync then
-    let ldecl_obj = (* "Local": doesn't survive section or modules. *)
-      declare_object {(default_object ("L  "^nickname key)) with
-		       cache_function = (fun (_,v) -> write v);
-		       classify_function = (fun _ -> Dispose)}
-    in
-    let decl_obj = (* default locality: survives sections but not modules. *)
-      declare_object {(default_object (nickname key)) with
-		       cache_function = (fun (_,v) -> write v);
-		       classify_function = (fun _ -> Dispose);
-		       discharge_function = (fun (_,v) -> Some v)}
-    in
-    let gdecl_obj = (* "Global": survives section and modules. *)
-      declare_object {(default_object ("G  "^nickname key)) with
-		       cache_function = (fun (_,v) -> write v);
-		       classify_function = (fun v -> Substitute v);
-		       subst_function = (fun (_,v) -> v);
-		       discharge_function = (fun (_,v) -> Some v);
-		       load_function = (fun _ (_,v) -> write v)}
-    in
-    let _ = Summary.declare_summary (nickname key)
-	     { Summary.freeze_function = (fun _ -> read ());
-	       Summary.unfreeze_function = write;
-	       Summary.init_function = (fun () -> write default) }
-    in
-    begin fun v -> add_anonymous_leaf (decl_obj v) end ,
-    begin fun v -> add_anonymous_leaf (ldecl_obj v) end ,
-    begin fun v -> add_anonymous_leaf (gdecl_obj v) end
-  else write,write,write
-  in
-  let warn () =
-    if depr then
-      Feedback.msg_warning (str "Option " ++ str (nickname key) ++ str " is deprecated")
+  let change =
+    if sync then
+      let _ = Summary.declare_summary (nickname key)
+        { Summary.freeze_function = (fun _ -> read ());
+          Summary.unfreeze_function = write;
+          Summary.init_function = (fun () -> write default) } in
+      let cache_options (_,(l,m,v)) =
+        match m with
+        | OptSet -> write v
+        | OptAppend -> write (append (read ()) v) in
+      let load_options i o = cache_options o in
+      let subst_options (subst,obj) = obj in
+      let discharge_options (_,(l,_,_ as o)) =
+        match l with OptLocal -> None | _ -> Some o in
+      let classify_options (l,_,_ as o) =
+        match l with OptGlobal -> Substitute o | _ -> Dispose in
+      let options : option_locality * option_mod * _ -> obj =
+        declare_object
+          { (default_object (nickname key)) with
+            load_function = load_options;
+            cache_function = cache_options;
+            subst_function = subst_options;
+            discharge_function = discharge_options;
+            classify_function = classify_options } in
+      (fun l m v -> let v = preprocess v in Lib.add_anonymous_leaf (options (l, m, v)))
+    else
+      (fun _ m v ->
+        let v = preprocess v in
+        match m with
+       | OptSet -> write v
+       | OptAppend -> write (append (read ()) v))
   in
+  let warn () = if depr then warn_deprecated_option key in
   let cread () = cast (read ()) in
-  let cwrite v = warn (); write (uncast v) in
-  let clwrite v = warn (); lwrite (uncast v) in
-  let cgwrite v = warn (); gwrite (uncast v) in
-  value_tab := OptionMap.add key (name, depr, (sync,cread,cwrite,clwrite,cgwrite)) !value_tab;
+  let cwrite l v = warn (); change l OptSet (uncast v) in
+  let cappend l v = warn (); change l OptAppend (uncast v) in
+  value_tab := OptionMap.add key (name, depr, (sync,cread,cwrite,cappend)) !value_tab;
   write
 
 type 'a write_function = 'a -> unit
@@ -287,36 +296,38 @@ let declare_int_option =
   declare_option
     (fun v -> IntValue v)
     (function IntValue v -> v | _ -> anomaly (Pp.str "async_option"))
+    (fun _ _ -> anomaly (Pp.str "async_option"))
 let declare_bool_option =
   declare_option
     (fun v -> BoolValue v)
     (function BoolValue v -> v | _ -> anomaly (Pp.str "async_option"))
+    (fun _ _ -> anomaly (Pp.str "async_option"))
 let declare_string_option =
   declare_option
     (fun v -> StringValue v)
     (function StringValue v -> v | _ -> anomaly (Pp.str "async_option"))
+    (fun x y -> x^","^y)
 let declare_stringopt_option =
   declare_option
     (fun v -> StringOptValue v)
     (function StringOptValue v -> v | _ -> anomaly (Pp.str "async_option"))
+    (fun _ _ -> anomaly (Pp.str "async_option"))
 
 (* 3- User accessible commands *)
 
 (* Setting values of options *)
 
+let warn_unknown_option =
+  CWarnings.create ~name:"unknown-option" ~category:"option"
+                   (fun key -> strbrk "There is no option " ++
+                                 str (nickname key) ++ str ".")
+
 let set_option_value locality check_and_cast key v =
-  let (name, depr, (_,read,write,lwrite,gwrite)) =
-    try get_option key
-    with Not_found ->
-      errorlabstrm "Goptions.set_option_value"
-        (str "There is no option " ++ str (nickname key) ++ str ".")
-  in
-  let write = match locality with
-    | None -> write
-    | Some true -> lwrite
-    | Some false -> gwrite
-  in
-  write (check_and_cast v (read ()))
+  let opt = try Some (get_option key) with Not_found -> None in
+  match opt with
+  | None -> warn_unknown_option key
+  | Some (name, depr, (_,read,write,append)) ->
+    write (get_locality locality) (check_and_cast v (read ()))
 
 let bad_type_error () = error "Bad type of value for this option."
 
@@ -346,13 +357,18 @@ let check_unset_value v = function
 let set_int_option_value_gen locality =
   set_option_value locality check_int_value
 let set_bool_option_value_gen locality key v =
-  try set_option_value locality check_bool_value key v
-  with UserError (_,s) -> Feedback.msg_warning s
+  set_option_value locality check_bool_value key v
 let set_string_option_value_gen locality =
   set_option_value locality check_string_value
 let unset_option_value_gen locality key =
-  try set_option_value locality check_unset_value key ()
-  with UserError (_,s) -> Feedback.msg_warning s
+  set_option_value locality check_unset_value key ()
+
+let set_string_option_append_value_gen locality key v =
+  let opt = try Some (get_option key) with Not_found -> None in
+  match opt with
+  | None -> warn_unknown_option key
+  | Some (name, depr, (_,read,write,append)) ->
+    append (get_locality locality) (check_string_value v (read ()))
 
 let set_int_option_value = set_int_option_value_gen None
 let set_bool_option_value = set_bool_option_value_gen None
@@ -362,17 +378,17 @@ let set_string_option_value = set_string_option_value_gen None
 
 let msg_option_value (name,v) =
   match v with
-    | BoolValue true  -> str "true"
-    | BoolValue false -> str "false"
+    | BoolValue true  -> str "on"
+    | BoolValue false -> str "off"
     | IntValue (Some n) -> int n
     | IntValue None   -> str "undefined"
-    | StringValue s   -> str s
+    | StringValue s   -> quote (str s)
     | StringOptValue None   -> str"undefined"
-    | StringOptValue (Some s)   -> str s
+    | StringOptValue (Some s)   -> quote (str s)
 (*     | IdentValue r    -> pr_global_env Id.Set.empty r *)
 
 let print_option_value key =
-  let (name, depr, (_,read,_,_,_)) = get_option key in
+  let (name, depr, (_,read,_,_)) = get_option key in
   let s = read () in
   match s with
     | BoolValue b ->
@@ -382,7 +398,7 @@ let print_option_value key =
 
 let get_tables () =
   let tables = !value_tab in
-  let fold key (name, depr, (sync,read,_,_,_)) accu =
+  let fold key (name, depr, (sync,read,_,_)) accu =
     let state = {
       opt_sync = sync;
       opt_name = name;
@@ -401,13 +417,13 @@ let print_tables () =
   in
   str "Synchronous options:" ++ fnl () ++
     OptionMap.fold
-      (fun key (name, depr, (sync,read,_,_,_)) p ->
+      (fun key (name, depr, (sync,read,_,_)) p ->
         if sync then p ++ print_option key name (read ()) depr
         else p)
       !value_tab (mt ()) ++
   str "Asynchronous options:" ++ fnl () ++
     OptionMap.fold
-      (fun key (name, depr, (sync,read,_,_,_)) p ->
+      (fun key (name, depr, (sync,read,_,_)) p ->
         if sync then p
         else p ++ print_option key name (read ()) depr)
       !value_tab (mt ()) ++
diff --git a/library/goptions.mli b/library/goptions.mli
index 26864503b..3b3651f39 100644
--- a/library/goptions.mli
+++ b/library/goptions.mli
@@ -122,13 +122,19 @@ type 'a option_sig = {
 
 (** When an option is declared synchronous ([optsync] is [true]), the output is
    a synchronous write function. Otherwise it is [optwrite] *)
+(** The [preprocess] function is triggered before setting the option. It can be
+    used to emit a warning on certain values, and clean-up the final value. *)
 
 type 'a write_function = 'a -> unit
 
-val declare_int_option   : int option option_sig -> int option write_function
-val declare_bool_option  : bool option_sig   -> bool write_function
-val declare_string_option: string option_sig -> string write_function
-val declare_stringopt_option: string option option_sig -> string option write_function
+val declare_int_option   : ?preprocess:(int option -> int option) ->
+                           int option option_sig -> int option write_function
+val declare_bool_option  : ?preprocess:(bool -> bool) ->
+                           bool option_sig   -> bool write_function
+val declare_string_option: ?preprocess:(string -> string) ->
+                           string option_sig -> string write_function
+val declare_stringopt_option: ?preprocess:(string option -> string option) ->
+                              string option option_sig -> string option write_function
 
 
 (** {6 Special functions supposed to be used only in vernacentries.ml } *)
@@ -154,6 +160,7 @@ val get_ref_table :
 val set_int_option_value_gen    : bool option -> option_name -> int option -> unit
 val set_bool_option_value_gen   : bool option -> option_name -> bool   -> unit
 val set_string_option_value_gen : bool option -> option_name -> string -> unit
+val set_string_option_append_value_gen : bool option -> option_name -> string -> unit
 val unset_option_value_gen : bool option -> option_name -> unit
 
 val set_int_option_value    : option_name -> int option -> unit
diff --git a/library/heads.ml b/library/heads.ml
index 4c9b78976..02465f22f 100644
--- a/library/heads.ml
+++ b/library/heads.ml
@@ -70,7 +70,7 @@ let kind_of_head env t =
   | Const (cst,_) ->
       (try on_subterm k l b (constant_head cst)
        with Not_found ->
-         Errors.anomaly
+         CErrors.anomaly
            Pp.(str "constant not found in kind_of_head: " ++
                str (Names.Constant.to_string cst)))
   | Construct _ | CoFix _ ->
diff --git a/library/impargs.ml b/library/impargs.ml
index 4e344a954..836568b89 100644
--- a/library/impargs.ml
+++ b/library/impargs.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-open Errors
+open CErrors
 open Util
 open Names
 open Globnames
@@ -22,6 +22,9 @@ open Constrexpr
 open Termops
 open Namegen
 open Decl_kinds
+open Context.Named.Declaration
+
+module NamedDecl = Context.Named.Declaration
 
 (*s Flags governing the computation of implicit arguments *)
 
@@ -68,15 +71,14 @@ let is_reversible_pattern_implicit_args () = !implicit_args.reversible_pattern
 let is_contextual_implicit_args () = !implicit_args.contextual
 let is_maximal_implicit_args () = !implicit_args.maximal
 
-let with_implicits flags f x =
+let with_implicit_protection f x =
   let oflags = !implicit_args in
   try
-    implicit_args := flags;
     let rslt = f x in
     implicit_args := oflags;
     rslt
   with reraise ->
-    let reraise = Errors.push reraise in
+    let reraise = CErrors.push reraise in
     let () = implicit_args := oflags in
     iraise reraise
 
@@ -165,7 +167,6 @@ let update pos rig (na,st) =
 
 (* modified is_rigid_reference with a truncated env *)
 let is_flexible_reference env bound depth f =
-  let open Context.Named.Declaration in
   match kind_of_term f with
     | Rel n when n >= bound+depth -> (* inductive type *) false
     | Rel n when n >= depth -> (* previous argument *) true
@@ -174,7 +175,7 @@ let is_flexible_reference env bound depth f =
         let cb = Environ.lookup_constant kn env in
 	(match cb.const_body with Def _ -> true | _ -> false)
     | Var id ->
-        Environ.lookup_named id env |> is_local_def
+        env |> Environ.lookup_named id |> is_local_def
     | Ind _ | Construct _ -> false
     |  _ -> true
 
@@ -188,7 +189,7 @@ let is_reversible_pattern bound depth f l =
 (* Precondition: rels in env are for inductive types only *)
 let add_free_rels_until strict strongly_strict revpat bound env m pos acc =
   let rec frec rig (env,depth as ed) c =
-    let hd = if strict then whd_betadeltaiota env c else c in
+    let hd = if strict then whd_all env c else c in
     let c = if strongly_strict then hd else c in
     match kind_of_term hd with
     | Rel n when (n < bound+depth) && (n >= depth) ->
@@ -236,7 +237,7 @@ let compute_implicits_gen strict strongly_strict revpat contextual all env t =
   let rigid = ref true in
   let open Context.Rel.Declaration in
   let rec aux env avoid n names t =
-    let t = whd_betadeltaiota env t in
+    let t = whd_all env t in
     match kind_of_term t with
       | Prod (na,a,b) ->
 	  let na',avoid' = find_displayed_name_in all avoid na (names,b) in
@@ -250,7 +251,7 @@ let compute_implicits_gen strict strongly_strict revpat contextual all env t =
 	    add_free_rels_until strict strongly_strict revpat n env t Conclusion v
 	  else v
   in
-  match kind_of_term (whd_betadeltaiota env t) with
+  match kind_of_term (whd_all env t) with
     | Prod (na,a,b) ->
 	let na',avoid = find_displayed_name_in all [] na ([],b) in
 	let v = aux (push_rel (LocalAssum (na',a)) env) avoid 1 [na'] b in
@@ -339,14 +340,14 @@ let check_correct_manual_implicits autoimps l =
   List.iter (function
     | ExplByName id,(b,fi,forced) ->
 	if not forced then
-	  errorlabstrm ""
+	  user_err 
             (str "Wrong or non-dependent implicit argument name: " ++ pr_id id ++ str ".")
     | ExplByPos (i,_id),_t ->
 	if i<1 || i>List.length autoimps then
-	  errorlabstrm ""
+	  user_err 
             (str "Bad implicit argument number: " ++ int i ++ str ".")
 	else
-	  errorlabstrm ""
+	  user_err 
 	    (str "Cannot set implicit argument number " ++ int i ++
 	      str ": it has no name.")) l
 
@@ -450,8 +451,7 @@ let compute_all_mib_implicits flags manual kn =
 
 let compute_var_implicits flags manual id =
   let env = Global.env () in
-  let open Context.Named.Declaration in
-  compute_semi_auto_implicits env flags manual (get_type (lookup_named id env))
+  compute_semi_auto_implicits env flags manual (NamedDecl.get_type (lookup_named id env))
 
 (* Implicits of a global reference. *)
 
@@ -492,13 +492,15 @@ let implicits_of_global ref =
     let l = Refmap.find ref !implicits_table in
     try
       let rename_l = Arguments_renaming.arguments_names ref in
-      let rename imp name = match imp, name with
-       | Some (_, x,y), Name id -> Some (id, x,y)
-       | _ -> imp in
-      List.map2 (fun (t, il) rl -> t, List.map2 rename il rl) l rename_l
+      let rec rename implicits names = match implicits, names with
+        | [], _ -> []
+        | _, [] -> implicits
+        | Some (_, x,y) :: implicits, Name id :: names ->
+           Some (id, x,y) :: rename implicits names
+        | imp :: implicits, _ :: names -> imp :: rename implicits names
+      in
+      List.map (fun (t, il) -> t, rename il rename_l) l
     with Not_found -> l
-    | Invalid_argument _ ->
-        anomaly (Pp.str "renamings list and implicits list have different lenghts")
   with Not_found -> [DefaultImpArgs,[]]
 
 let cache_implicits_decl (ref,imps) =
@@ -516,21 +518,11 @@ let subst_implicits (subst,(req,l)) =
   (ImplLocal,List.smartmap (subst_implicits_decl subst) l)
 
 let impls_of_context ctx =
-  let map (id, impl, _, _) = match impl with
-  | Implicit -> Some (id, Manual, (true, true))
+  let map (decl, impl) = match impl with
+  | Implicit -> Some (NamedDecl.get_id decl, Manual, (true, true))
   | _ -> None
   in
-  let is_set (_, _, b, _) = match b with
-  | None -> true
-  | Some _ -> false
-  in
-  List.rev_map map (List.filter is_set ctx)
-
-let section_segment_of_reference = function
-  | ConstRef con -> pi1 (section_segment_of_constant con)
-  | IndRef (kn,_) | ConstructRef ((kn,_),_) ->
-    pi1 (section_segment_of_mutual_inductive kn)
-  | _ -> []
+  List.rev_map map (List.filter (fst %> is_local_assum) ctx)
 
 let adjust_side_condition p = function
   | LessArgsThan n -> LessArgsThan (n+p)
@@ -545,7 +537,7 @@ let discharge_implicits (_,(req,l)) =
   | ImplLocal -> None
   | ImplInteractive (ref,flags,exp) ->
     (try
-      let vars = section_segment_of_reference ref in
+      let vars = variable_section_segment_of_reference ref in
       let ref' = if isVarRef ref then ref else pop_global_reference ref in
       let extra_impls = impls_of_context vars in
       let l' = [ref', List.map (add_section_impls vars extra_impls) (snd (List.hd l))] in
@@ -563,7 +555,7 @@ let discharge_implicits (_,(req,l)) =
   | ImplMutualInductive (kn,flags) ->
     (try
       let l' = List.map (fun (gr, l) ->
-	let vars = section_segment_of_reference gr in
+	let vars = variable_section_segment_of_reference gr in
 	let extra_impls = impls_of_context vars in
 	((if isVarRef gr then gr else pop_global_reference gr),
 	 List.map (add_section_impls vars extra_impls) l)) l
@@ -664,14 +656,14 @@ let check_inclusion l =
   let rec aux = function
     | n1::(n2::_ as nl) ->
 	if n1 <= n2 then
-	  error "Sequences of implicit arguments must be of different lengths";
+	  error "Sequences of implicit arguments must be of different lengths.";
 	aux nl
     | _ -> () in
   aux (List.map (fun (imps,_) -> List.length imps) l)
 
 let check_rigidity isrigid =
   if not isrigid then
-    errorlabstrm "" (strbrk "Multiple sequences of implicit arguments available only for references that cannot be applied to an arbitrarily large number of arguments.")
+    user_err  (strbrk "Multiple sequences of implicit arguments available only for references that cannot be applied to an arbitrarily large number of arguments.")
 
 let projection_implicits env p impls = 
   let pb = Environ.lookup_projection p env in
diff --git a/library/impargs.mli b/library/impargs.mli
index 34e529ca2..3919a519c 100644
--- a/library/impargs.mli
+++ b/library/impargs.mli
@@ -29,8 +29,7 @@ val is_reversible_pattern_implicit_args : unit -> bool
 val is_contextual_implicit_args : unit -> bool
 val is_maximal_implicit_args : unit -> bool
 
-type implicits_flags
-val with_implicits : implicits_flags -> ('a -> 'b) -> 'a -> 'b
+val with_implicit_protection : ('a -> 'b) -> 'a -> 'b
 
 (** {6 ... } *)
 (** An [implicits_list] is a list of positions telling which arguments
@@ -136,14 +135,5 @@ val select_impargs_size : int -> implicits_list list -> implicit_status list
 
 val select_stronger_impargs : implicits_list list -> implicit_status list
 
-type implicit_interactive_request
-
-type implicit_discharge_request =
-  | ImplLocal
-  | ImplConstant of constant * implicits_flags
-  | ImplMutualInductive of mutual_inductive * implicits_flags
-  | ImplInteractive of global_reference * implicits_flags *
-      implicit_interactive_request
-
 val explicitation_eq : Constrexpr.explicitation -> Constrexpr.explicitation -> bool
 (** Equality on [explicitation]. *)
diff --git a/library/kindops.ml b/library/kindops.ml
index c634193da..21b1bec33 100644
--- a/library/kindops.ml
+++ b/library/kindops.ml
@@ -25,7 +25,7 @@ let string_of_theorem_kind = function
 
 let string_of_definition_kind def =
   let (locality, poly, kind) = def in
-  let error () = Errors.anomaly (Pp.str "Internal definition kind") in
+  let error () = CErrors.anomaly (Pp.str "Internal definition kind") in
   match kind with
   | Definition ->
     begin match locality with
@@ -64,4 +64,4 @@ let string_of_definition_kind def =
     | Global -> "Global Instance"
     end
   | (StructureComponent|Scheme|CoFixpoint|Fixpoint|IdentityCoercion|Method) ->
-    Errors.anomaly (Pp.str "Internal definition kind")
+    CErrors.anomaly (Pp.str "Internal definition kind")
diff --git a/library/lib.ml b/library/lib.ml
index f8bb6bac5..4fd29a94d 100644
--- a/library/lib.ml
+++ b/library/lib.ml
@@ -7,12 +7,15 @@
 (************************************************************************)
 
 open Pp
-open Errors
+open CErrors
 open Util
 open Libnames
 open Globnames
 open Nameops
 open Libobject
+open Context.Named.Declaration
+
+module NamedDecl = Context.Named.Declaration
 
 type is_type = bool (* Module Type or just Module *)
 type export = bool option (* None for a Module Type *)
@@ -75,7 +78,7 @@ let classify_segment seg =
     | (_,ClosedModule _) :: stk -> clean acc stk
     | (_,OpenedSection _) :: _ -> error "there are still opened sections"
     | (_,OpenedModule (ty,_,_,_)) :: _ ->
-      errorlabstrm "Lib.classify_segment"
+      user_err ~hdr:"Lib.classify_segment"
         (str "there are still opened " ++ str (module_kind ty) ++ str "s")
     | (_,FrozenState _) :: stk -> clean acc stk
   in
@@ -231,11 +234,16 @@ let add_leaves id objs =
   List.iter add_obj objs;
   oname
 
-let add_anonymous_leaf obj =
+let add_anonymous_leaf ?(cache_first = true) obj =
   let id = anonymous_id () in
   let oname = make_oname id in
-  cache_object (oname,obj);
-  add_entry oname (Leaf obj)
+  if cache_first then begin
+    cache_object (oname,obj);
+    add_entry oname (Leaf obj)
+  end else begin
+    add_entry oname (Leaf obj);
+    cache_object (oname,obj)
+  end
 
 let add_frozen_state () =
   add_anonymous_entry
@@ -267,7 +275,7 @@ let start_mod is_type export id mp fs =
     else Nametab.exists_module dir
   in
   if exists then
-    errorlabstrm "open_module" (pr_id id ++ str " already exists");
+    user_err ~hdr:"open_module" (pr_id id ++ str " already exists");
   add_entry (make_oname id) (OpenedModule (is_type,export,prefix,fs));
   path_prefix := prefix;
   prefix
@@ -277,7 +285,7 @@ let start_modtype = start_mod true None
 
 let error_still_opened string oname =
   let id = basename (fst oname) in
-  errorlabstrm ""
+  user_err 
     (str "The " ++ str string ++ str " " ++ pr_id id ++ str " is still opened.")
 
 let end_mod is_type =
@@ -322,7 +330,7 @@ let end_compilation_checks dir =
     try match snd (find_entry_p is_opening_node) with
       | OpenedSection _ -> error "There are some open sections."
       | OpenedModule (ty,_,_,_) ->
-	errorlabstrm "Lib.end_compilation_checks"
+	user_err ~hdr:"Lib.end_compilation_checks"
           (str "There are some open " ++ str (module_kind ty) ++ str "s.")
       | _ -> assert false
     with Not_found -> ()
@@ -374,7 +382,7 @@ let find_opening_node id =
     let oname,entry = find_entry_p is_opening_node in
     let id' = basename (fst oname) in
     if not (Names.Id.equal id id') then
-      errorlabstrm "Lib.find_opening_node"
+      user_err ~hdr:"Lib.find_opening_node"
         (str "Last block to end has name " ++ pr_id id' ++ str ".");
     entry
   with Not_found -> error "There is nothing to end."
@@ -388,7 +396,7 @@ let find_opening_node id =
    - the list of substitution to do at section closing
 *)
 
-type variable_info = Names.Id.t * Decl_kinds.binding_kind * Term.constr option * Term.types
+type variable_info = Context.Named.Declaration.t * Decl_kinds.binding_kind
 
 type variable_context = variable_info list
 type abstr_info = variable_context * Univ.universe_level_subst * Univ.UContext.t
@@ -417,7 +425,7 @@ let add_section_variable id impl poly ctx =
   match !sectab with
     | [] -> () (* because (Co-)Fixpoint temporarily uses local vars *)
     | (vars,repl,abs)::sl ->
-       check_same_poly poly vars;
+       List.iter (fun tab -> check_same_poly poly (pi1 tab)) !sectab;
        sectab := (Variable (id,impl,poly,ctx)::vars,repl,abs)::sl
 
 let add_section_context ctx =
@@ -428,12 +436,10 @@ let add_section_context ctx =
        sectab := (Context ctx :: vars,repl,abs)::sl
 
 let extract_hyps (secs,ohyps) =
-  let open Context.Named.Declaration in
   let rec aux = function
-    | (Variable (id,impl,poly,ctx)::idl, decl::hyps) when Names.Id.equal id (get_id decl) ->
-      let (id',b,t) = to_tuple decl in
+    | (Variable (id,impl,poly,ctx)::idl, decl::hyps) when Names.Id.equal id (NamedDecl.get_id decl) ->
       let l, r = aux (idl,hyps) in 
-	(id',impl,b,t) :: l, if poly then Univ.ContextSet.union r ctx else r
+      (decl,impl) :: l, if poly then Univ.ContextSet.union r ctx else r
     | (Variable (_,_,poly,ctx)::idl,hyps) ->
         let l, r = aux (idl,hyps) in
           l, if poly then Univ.ContextSet.union r ctx else r
@@ -443,17 +449,11 @@ let extract_hyps (secs,ohyps) =
     | [], _ -> [],Univ.ContextSet.empty
   in aux (secs,ohyps)
 
-let instance_from_variable_context sign =
-  let rec inst_rec = function
-    | (id,b,None,_) :: sign -> id :: inst_rec sign
-    | _ :: sign -> inst_rec sign
-    | [] -> [] in
-  Array.of_list (inst_rec sign)
-
-let named_of_variable_context ctx = let open Context.Named.Declaration in
-                                    List.map (function id,_,None,t -> LocalAssum (id,t)
-                                                     | id,_,Some b,t -> LocalDef (id,b,t))
-                                             ctx
+let instance_from_variable_context =
+  List.map fst %> List.filter is_local_assum %> List.map NamedDecl.get_id %> Array.of_list
+
+let named_of_variable_context =
+  List.map fst
   
 let add_section_replacement f g poly hyps =
   match !sectab with
@@ -483,6 +483,12 @@ let section_segment_of_constant con =
 let section_segment_of_mutual_inductive kn =
   Names.Mindmap.find kn (snd (pi3 (List.hd !sectab)))
 
+let variable_section_segment_of_reference = function
+  | ConstRef con -> pi1 (section_segment_of_constant con)
+  | IndRef (kn,_) | ConstructRef ((kn,_),_) ->
+      pi1 (section_segment_of_mutual_inductive kn)
+  | _ -> []
+                     
 let section_instance = function
   | VarRef id ->
      let eq = function
@@ -500,13 +506,6 @@ let section_instance = function
 let is_in_section ref =
   try ignore (section_instance ref); true with Not_found -> false
 
-let full_replacement_context () = List.map pi2 !sectab
-let full_section_segment_of_constant con =
-  List.map (fun (vars,_,(x,_)) -> fun hyps ->
-    named_of_variable_context
-      (try pi1 (Names.Cmap.find con x)
-       with Not_found -> fst (extract_hyps (vars, hyps)))) !sectab
-
 (*************)
 (* Sections. *)
 
@@ -519,7 +518,7 @@ let open_section id =
   let dir = add_dirpath_suffix olddir id in
   let prefix = dir, (mp, add_dirpath_suffix oldsec id) in
   if Nametab.exists_section dir then
-    errorlabstrm "open_section" (pr_id id ++ str " already exists.");
+    user_err ~hdr:"open_section" (pr_id id ++ str " already exists.");
   let fs = Summary.freeze_summaries ~marshallable:`No in
   add_entry (make_oname id) (OpenedSection (prefix, fs));
   (*Pushed for the lifetime of the section: removed by unfrozing the summary*)
@@ -607,15 +606,6 @@ let rec dp_of_mp = function
   |Names.MPbound _ -> library_dp ()
   |Names.MPdot (mp,_) -> dp_of_mp mp
 
-let rec split_mp = function
-  |Names.MPfile dp -> dp, Names.DirPath.empty
-  |Names.MPdot (prfx, lbl) ->
-    let mprec, dprec = split_mp prfx in
-    mprec, Libnames.add_dirpath_suffix dprec (Names.Label.to_id lbl)
-  |Names.MPbound mbid ->
-    let (_,id,dp) = Names.MBId.repr mbid in
-    library_dp (), Names.DirPath.make [id]
-
 let rec split_modpath = function
   |Names.MPfile dp -> dp, []
   |Names.MPbound mbid -> library_dp (), [Names.MBId.to_id mbid]
@@ -627,20 +617,6 @@ let library_part = function
   |VarRef id -> library_dp ()
   |ref -> dp_of_mp (mp_of_global ref)
 
-let remove_section_part ref =
-  let sp = Nametab.path_of_global ref in
-  let dir,_ = repr_path sp in
-  match ref with
-  | VarRef id ->
-      anomaly (Pp.str "remove_section_part not supported on local variables")
-  | _ ->
-      if is_dirpath_prefix_of dir (cwd ()) then
-        (* Not yet (fully) discharged *)
-        pop_dirpath_n (sections_depth ()) (cwd ())
-      else
-	(* Theorem/Lemma outside its outer section of definition *)
-	dir
-
 (************************)
 (* Discharging names *)
 
diff --git a/library/lib.mli b/library/lib.mli
index e2e71ac90..9f9d8c7e5 100644
--- a/library/lib.mli
+++ b/library/lib.mli
@@ -54,7 +54,7 @@ val segment_of_objects :
   current list of operations (most recent ones coming first). *)
 
 val add_leaf : Names.Id.t -> Libobject.obj -> Libnames.object_name
-val add_anonymous_leaf : Libobject.obj -> unit
+val add_anonymous_leaf : ?cache_first:bool -> Libobject.obj -> unit
 val pull_to_head : Libnames.object_name -> unit
 
 (** this operation adds all objects with the same name and calls [load_object]
@@ -138,10 +138,8 @@ val library_dp : unit -> Names.DirPath.t
 
 (** Extract the library part of a name even if in a section *)
 val dp_of_mp : Names.module_path -> Names.DirPath.t
-val split_mp : Names.module_path -> Names.DirPath.t * Names.DirPath.t
 val split_modpath : Names.module_path -> Names.DirPath.t * Names.Id.t list
 val library_part :  Globnames.global_reference -> Names.DirPath.t
-val remove_section_part : Globnames.global_reference -> Names.DirPath.t
 
 (** {6 Sections } *)
 
@@ -162,8 +160,7 @@ val xml_open_section : (Names.Id.t -> unit) Hook.t
 val xml_close_section : (Names.Id.t -> unit) Hook.t
 
 (** {6 Section management for discharge } *)
-type variable_info = Names.Id.t * Decl_kinds.binding_kind *
-    Term.constr option * Term.types
+type variable_info = Context.Named.Declaration.t * Decl_kinds.binding_kind
 type variable_context = variable_info list 
 type abstr_info = variable_context * Univ.universe_level_subst * Univ.UContext.t
 
@@ -172,7 +169,8 @@ val named_of_variable_context : variable_context -> Context.Named.t
 
 val section_segment_of_constant : Names.constant -> abstr_info
 val section_segment_of_mutual_inductive: Names.mutual_inductive -> abstr_info
-
+val variable_section_segment_of_reference : Globnames.global_reference -> variable_context
+                                                                                                     
 val section_instance : Globnames.global_reference -> Univ.universe_instance * Names.Id.t array
 val is_in_section : Globnames.global_reference -> bool
 
@@ -190,10 +188,3 @@ val discharge_kn :  Names.mutual_inductive -> Names.mutual_inductive
 val discharge_con : Names.constant -> Names.constant
 val discharge_global : Globnames.global_reference -> Globnames.global_reference
 val discharge_inductive : Names.inductive -> Names.inductive
-
-(* discharging a constant in one go *)
-val full_replacement_context : unit -> Opaqueproof.work_list list
-val full_section_segment_of_constant :
-  Names.constant -> (Context.Named.t -> Context.Named.t) list
-
-
diff --git a/library/libnames.ml b/library/libnames.ml
index 99ff2f2fb..dd74e192f 100644
--- a/library/libnames.ml
+++ b/library/libnames.ml
@@ -7,7 +7,7 @@
 (************************************************************************)
 
 open Pp
-open Errors
+open CErrors
 open Util
 open Names
 
diff --git a/library/libobject.ml b/library/libobject.ml
index b12d2038a..caa03c85b 100644
--- a/library/libobject.ml
+++ b/library/libobject.ml
@@ -12,18 +12,6 @@ open Util
 
 module Dyn = Dyn.Make(struct end)
 
-(* 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
-   wants to work with restricted Coq programs that have only parts of
-   the full capabilities, but may still be able to work correctly for
-   limited purposes.  One example is for the graphical interface, that uses
-   such a limited Coq process to do only parsing.  It loads .vo files, but
-   is only interested in loading the grammar rule definitions. *)
-
-let relax_flag = ref false;;
-
-let relax b = relax_flag := b;;
-
 type 'a substitutivity =
     Dispose | Substitute of 'a | Keep of 'a | Anticipate of 'a
 
@@ -43,7 +31,7 @@ let default_object s = {
   load_function = (fun _ _ -> ());
   open_function = (fun _ _ -> ());
   subst_function = (fun _ ->
-    Errors.anomaly (str "The object " ++ str s ++ str " does not know how to substitute!"));
+    CErrors.anomaly (str "The object " ++ str s ++ str " does not know how to substitute!"));
   classify_function = (fun obj -> Keep obj);
   discharge_function = (fun _ -> None);
   rebuild_function = (fun x -> x)}
@@ -109,36 +97,21 @@ let declare_object_full odecl =
 
 let declare_object odecl =
   try fst (declare_object_full odecl)
-  with e -> Errors.fatal_error (Errors.print e) (Errors.is_anomaly e)
+  with e -> CErrors.fatal_error (CErrors.print e) (CErrors.is_anomaly e)
 let declare_object_full odecl =
   try declare_object_full odecl
-  with e -> Errors.fatal_error (Errors.print e) (Errors.is_anomaly e)
-
-let missing_tab = (Hashtbl.create 17 : (string, unit) Hashtbl.t)
+  with e -> CErrors.fatal_error (CErrors.print e) (CErrors.is_anomaly e)
 
 (* this function describes how the cache, load, open, and export functions
-   are triggered.  In relaxed mode, this function just return a meaningless
-   value instead of raising an exception when they fail. *)
+   are triggered. *)
 
 let apply_dyn_fun deflt f lobj =
   let tag = object_tag lobj in
-  try
-    let dodecl =
-      try
-        Hashtbl.find cache_tab tag
-      with Not_found ->
-        failwith "local to_apply_dyn_fun" in
-    f dodecl
-  with
-    Failure "local to_apply_dyn_fun" ->
-      if not (!relax_flag || Hashtbl.mem missing_tab tag) then
-        begin
-          Feedback.msg_warning
-	    (Pp.str ("Cannot find library functions for an object with tag "
-                      ^ tag ^ " (a plugin may be missing)"));
-          Hashtbl.add missing_tab tag ()
-        end;
-      deflt
+  let dodecl =
+    try Hashtbl.find cache_tab tag
+    with Not_found -> assert false
+  in
+  f dodecl
 
 let cache_object ((_,lobj) as node) =
   apply_dyn_fun () (fun d -> d.dyn_cache_function node) lobj
diff --git a/library/libobject.mli b/library/libobject.mli
index dbe0de8f8..51b9af059 100644
--- a/library/libobject.mli
+++ b/library/libobject.mli
@@ -107,7 +107,6 @@ val subst_object : substitution * obj -> obj
 val classify_object : obj -> obj substitutivity
 val discharge_object : object_name * obj -> obj option
 val rebuild_object : obj -> obj
-val relax : bool -> unit
 
 (** {6 Debug} *)
 
diff --git a/library/library.ml b/library/library.ml
index 192700be7..3086e3d18 100644
--- a/library/library.ml
+++ b/library/library.ml
@@ -7,7 +7,7 @@
 (************************************************************************)
 
 open Pp
-open Errors
+open CErrors
 open Util
 
 open Names
@@ -35,7 +35,7 @@ module Delayed :
 sig
 
 type 'a delayed
-val in_delayed : string -> in_channel -> 'a delayed
+val in_delayed : string -> in_channel -> 'a delayed * Digest.t
 val fetch_delayed : 'a delayed -> 'a
 
 end =
@@ -50,7 +50,7 @@ type 'a delayed = {
 let in_delayed f ch =
   let pos = pos_in ch in
   let _, digest = System.skip_in_segment f ch in
-  { del_file = f; del_digest = digest; del_off = pos; }
+  ({ del_file = f; del_digest = digest; del_off = pos; }, digest)
 
 (** Fetching a table of opaque terms at position [pos] in file [f],
     expecting to find first a copy of [digest]. *)
@@ -64,7 +64,7 @@ let fetch_delayed del =
     let () = close_in ch in
     if not (String.equal digest digest') then raise (Faulty f);
     obj
-  with e when Errors.noncritical e -> raise (Faulty f)
+  with e when CErrors.noncritical e -> raise (Faulty f)
 
 end
 
@@ -131,7 +131,7 @@ let find_library dir =
 let try_find_library dir =
   try find_library dir
   with Not_found ->
-    errorlabstrm "Library.find_library"
+    user_err ~hdr:"Library.find_library"
       (str "Unknown library " ++ pr_dirpath dir)
 
 let register_library_filename dir f =
@@ -271,6 +271,12 @@ exception LibUnmappedDir
 exception LibNotFound
 type library_location = LibLoaded | LibInPath
 
+let warn_several_object_files =
+  CWarnings.create ~name:"several-object-files" ~category:"require"
+         (fun (vi, vo) -> str"Loading" ++ spc () ++ str vi ++
+                            strbrk " instead of " ++ str vo ++
+                            strbrk " because it is more recent")
+
 let locate_absolute_library dir =
   (* Search in loadpath *)
   let pref, base = split_dirpath dir in
@@ -287,9 +293,8 @@ let locate_absolute_library dir =
   | [] -> raise LibNotFound
   | [file] -> file
   | [vo;vi] when Unix.((stat vo).st_mtime < (stat vi).st_mtime) ->
-       Feedback.msg_warning (str"Loading " ++ str vi ++ str " instead of " ++
-         str vo ++ str " because it is more recent");
-       vi
+    warn_several_object_files (vi, vo);
+    vi
   | [vo;vi] -> vo
   | _ -> assert false
 
@@ -311,8 +316,7 @@ let locate_qualified_library ?root ?(warn = true) qid =
     | [lpath, file] -> lpath, file
     | [lpath_vo, vo; lpath_vi, vi]
       when Unix.((stat vo).st_mtime < (stat vi).st_mtime) ->
-       Feedback.msg_warning (str"Loading " ++ str vi ++ str " instead of " ++
-         str vo ++ str " because it is more recent");
+      warn_several_object_files (vi, vo);
        lpath_vi, vi
     | [lpath_vo, vo; _ ] -> lpath_vo, vo
     | _ -> assert false
@@ -325,12 +329,12 @@ let locate_qualified_library ?root ?(warn = true) qid =
 
 let error_unmapped_dir qid =
   let prefix, _ = repr_qualid qid in
-  errorlabstrm "load_absolute_library_from"
+  user_err ~hdr:"load_absolute_library_from"
     (str "Cannot load " ++ pr_qualid qid ++ str ":" ++ spc () ++
      str "no physical path bound to" ++ spc () ++ pr_dirpath prefix ++ fnl ())
 
 let error_lib_not_found qid =
-  errorlabstrm "load_absolute_library_from"
+  user_err ~hdr:"load_absolute_library_from"
     (str"Cannot find library " ++ pr_qualid qid ++ str" in loadpath")
 
 let try_locate_absolute_library dir =
@@ -374,7 +378,7 @@ let access_table what tables dp i =
       let t =
         try fetch_delayed f
         with Faulty f ->
-          errorlabstrm "Library.access_table"
+          user_err ~hdr:"Library.access_table"
             (str "The file " ++ str f ++ str " (bound to " ++ str dir_path ++
              str ") is inaccessible or corrupted,\ncannot load some " ++
              str what ++ str " in it.\n")
@@ -427,53 +431,55 @@ let mk_summary m = {
 let intern_from_file f =
   let ch = raw_intern_library f in
   let (lsd : seg_sum), _, digest_lsd = System.marshal_in_segment f ch in
-  let (lmd : seg_lib delayed) = in_delayed f ch in
+  let ((lmd : seg_lib delayed), digest_lmd) = in_delayed f ch in
   let (univs : seg_univ option), _, digest_u = System.marshal_in_segment f ch in
   let _ = System.skip_in_segment f ch in
   let _ = System.skip_in_segment f ch in
-  let (del_opaque : seg_proofs delayed) = in_delayed f ch in
+  let ((del_opaque : seg_proofs delayed),_) = in_delayed f ch in
   close_in ch;
   register_library_filename lsd.md_name f;
   add_opaque_table lsd.md_name (ToFetch del_opaque);
   let open Safe_typing in
   match univs with
-  | None -> mk_library lsd lmd (Dvo_or_vi digest_lsd) Univ.ContextSet.empty
+  | None -> mk_library lsd lmd (Dvo_or_vi digest_lmd) Univ.ContextSet.empty
   | Some (utab,uall,true) ->
       add_univ_table lsd.md_name (Fetched utab);
-      mk_library lsd lmd (Dvivo (digest_lsd,digest_u)) uall
+      mk_library lsd lmd (Dvivo (digest_lmd,digest_u)) uall
   | Some (utab,_,false) ->
       add_univ_table lsd.md_name (Fetched utab);
-      mk_library lsd lmd (Dvo_or_vi digest_lsd) Univ.ContextSet.empty
+      mk_library lsd lmd (Dvo_or_vi digest_lmd) Univ.ContextSet.empty
 
 module DPMap = Map.Make(DirPath)
 
 let rec intern_library (needed, contents) (dir, f) from =
-  Feedback.feedback(Feedback.FileDependency (from, DirPath.to_string dir));
   (* Look if in the current logical environment *)
   try (find_library dir).libsum_digests, (needed, contents)
   with Not_found ->
   (* Look if already listed and consequently its dependencies too *)
   try (DPMap.find dir contents).library_digests, (needed, contents)
   with Not_found ->
+  Feedback.feedback(Feedback.FileDependency (from, DirPath.to_string dir));
   (* [dir] is an absolute name which matches [f] which must be in loadpath *)
   let f = match f with Some f -> f | None -> try_locate_absolute_library dir in
   let m = intern_from_file f in
   if not (DirPath.equal dir m.library_name) then
-    errorlabstrm "load_physical_library"
+    user_err ~hdr:"load_physical_library"
       (str "The file " ++ str f ++ str " contains library" ++ spc () ++
        pr_dirpath m.library_name ++ spc () ++ str "and not library" ++
        spc() ++ pr_dirpath dir);
   Feedback.feedback (Feedback.FileLoaded(DirPath.to_string dir, f));
-  m.library_digests, intern_library_deps (needed, contents) dir m (Some f)
+  m.library_digests, intern_library_deps (needed, contents) dir m f
 
 and intern_library_deps libs dir m from =
   let needed, contents = Array.fold_left (intern_mandatory_library dir from) libs m.library_deps in
   (dir :: needed, DPMap.add dir m contents )
 
 and intern_mandatory_library caller from libs (dir,d) =
-  let digest, libs = intern_library libs (dir, None) from in
+  let digest, libs = intern_library libs (dir, None) (Some from) in
   if not (Safe_typing.digest_match ~actual:digest ~required:d) then
-    errorlabstrm "" (str "Compiled library " ++ pr_dirpath caller ++ str ".vo makes inconsistent assumptions over library " ++ pr_dirpath dir);
+    user_err (str "Compiled library " ++ pr_dirpath caller ++
+    str " (in file " ++ str from ++ str ") makes inconsistent assumptions \
+    over library " ++ pr_dirpath dir);
   libs
 
 let rec_intern_library libs (dir, f) =
@@ -547,12 +553,20 @@ let in_require : require_obj -> obj =
 
 let (f_xml_require, xml_require) = Hook.make ~default:ignore ()
 
+let warn_require_in_module =
+  CWarnings.create ~name:"require-in-module" ~category:"deprecated"
+                   (fun () -> strbrk "Require inside a module is" ++
+                              strbrk " deprecated and strongly discouraged. " ++
+                              strbrk "You can Require a module at toplevel " ++
+                              strbrk "and optionally Import it inside another one.")
+
 let require_library_from_dirpath modrefl export =
   let needed, contents = List.fold_left rec_intern_library ([], DPMap.empty) modrefl in
   let needed = List.rev_map (fun dir -> DPMap.find dir contents) needed in
   let modrefl = List.map fst modrefl in
     if Lib.is_module_or_modtype () then
       begin
+        warn_require_in_module ();
 	add_anonymous_leaf (in_require (needed,modrefl,None));
 	Option.iter (fun exp ->
 	  add_anonymous_leaf (in_import_library (modrefl,exp)))
@@ -568,8 +582,8 @@ let require_library_from_dirpath modrefl export =
 let safe_locate_module (loc,qid) =
   try Nametab.locate_module qid
   with Not_found ->
-    user_err_loc
-      (loc,"import_library", pr_qualid qid ++ str " is not a module")
+    user_err ~loc ~hdr:"import_library"
+      (pr_qualid qid ++ str " is not a module")
 
 let import_module export modl =
   (* Optimization: libraries in a raw in the list are imported
@@ -593,8 +607,8 @@ let import_module export modl =
             flush acc;
             try Declaremods.import_module export mp; aux [] l
             with Not_found ->
-              user_err_loc (loc,"import_library",
-                pr_qualid dir ++ str " is not a module"))
+              user_err ~loc ~hdr:"import_library"
+                (pr_qualid dir ++ str " is not a module"))
     | [] -> flush acc
   in aux [] modl
 
@@ -605,7 +619,7 @@ let check_coq_overwriting p id =
   let l = DirPath.repr p in
   let is_empty = match l with [] -> true | _ -> false in
   if not !Flags.boot && not is_empty && Id.equal (List.last l) coq_root then
-    errorlabstrm ""
+    user_err 
       (str "Cannot build module " ++ pr_dirpath p ++ str "." ++ pr_id id ++ str "." ++ spc () ++
       str "it starts with prefix \"Coq\" which is reserved for the Coq library.")
 
@@ -618,7 +632,7 @@ let check_module_name s =
     (if c = '\'' then str "\"'\"" else (str "'" ++ str (String.make 1 c) ++ str "'")) ++
     strbrk " is not allowed in module names\n"
   in
-  let err c = errorlabstrm "" (msg c) in
+  let err c = user_err  (msg c) in
   match String.get s 0 with
     | 'a' .. 'z' | 'A' .. 'Z' ->
         for i = 1 to (String.length s)-1 do
@@ -628,17 +642,14 @@ let check_module_name s =
         done
     | c -> err c
 
-let start_library f =
-  let () = if not (Sys.file_exists f) then
-    errorlabstrm "" (hov 0 (str "Can't find file" ++ spc () ++ str f))
-  in
+let start_library fo =
   let ldir0 =
     try
-      let lp = Loadpath.find_load_path (Filename.dirname f) in
+      let lp = Loadpath.find_load_path (Filename.dirname fo) in
       Loadpath.logical lp
     with Not_found -> Nameops.default_root_prefix
   in
-  let file = Filename.chop_extension (Filename.basename f) in
+  let file = Filename.chop_extension (Filename.basename fo) in
   let id = Id.of_string file in
   check_module_name file;
   check_coq_overwriting ldir0 id;
@@ -657,10 +668,10 @@ let load_library_todo f =
   let tasks, _, _ = System.marshal_in_segment f ch in
   let (s5 : seg_proofs), _, _ = System.marshal_in_segment f ch in
   close_in ch;
-  if tasks = None then errorlabstrm "restart" (str"not a .vio file");
-  if s2 = None then errorlabstrm "restart" (str"not a .vio file");
-  if s3 = None then errorlabstrm "restart" (str"not a .vio file");
-  if pi3 (Option.get s2) then errorlabstrm "restart" (str"not a .vio file");
+  if tasks = None then user_err ~hdr:"restart" (str"not a .vio file");
+  if s2 = None then user_err ~hdr:"restart" (str"not a .vio file");
+  if s3 = None then user_err ~hdr:"restart" (str"not a .vio file");
+  if pi3 (Option.get s2) then user_err ~hdr:"restart" (str"not a .vio file");
   longf, s0, s1, Option.get s2, Option.get s3, Option.get tasks, s5
 
 (************************************************************************)
@@ -676,7 +687,7 @@ let current_deps () =
 let current_reexports () = !libraries_exports_list
 
 let error_recursively_dependent_library dir =
-  errorlabstrm ""
+  user_err 
     (strbrk "Unable to use logical name " ++ pr_dirpath dir ++
      strbrk " to save current library because" ++
      strbrk " it already depends on a library of this name.")
@@ -693,12 +704,13 @@ let error_recursively_dependent_library dir =
    writing the content and computing the checksum... *)
 
 let save_library_to ?todo dir f otab =
-  let f, except = match todo with
+  let except = match todo with
     | None ->
         assert(!Flags.compilation_mode = Flags.BuildVo);
-        f ^ "o", Future.UUIDSet.empty
+        assert(Filename.check_suffix f ".vo");
+        Future.UUIDSet.empty
     | Some (l,_) ->
-        f ^ "io",
+        assert(Filename.check_suffix f ".vio");
         List.fold_left (fun e (r,_) -> Future.UUIDSet.add r.Stateid.uuid e)
           Future.UUIDSet.empty l in
   let cenv, seg, ast = Declaremods.end_library ~except dir in
@@ -722,7 +734,7 @@ let save_library_to ?todo dir f otab =
       except Int.Set.empty in
   let is_done_or_todo i x = Future.is_val x || Int.Set.mem i except in
   Array.iteri (fun i x ->
-    if not(is_done_or_todo i x) then Errors.errorlabstrm "library"
+    if not(is_done_or_todo i x) then CErrors.user_err ~hdr:"library"
       Pp.(str"Proof object "++int i++str" is not checked nor to be checked"))
     opaque_table;
   let sd = {
@@ -754,7 +766,7 @@ let save_library_to ?todo dir f otab =
       if not (Nativelib.compile_library dir ast fn) then
 	error "Could not compile the library to native code."
    with reraise ->
-    let reraise = Errors.push reraise in
+    let reraise = CErrors.push reraise in
     let () = Feedback.msg_warning (str "Removed file " ++ str f') in
     let () = close_out ch in
     let () = Sys.remove f' in
diff --git a/library/library.mli b/library/library.mli
index 8f5b775d8..b9044b60d 100644
--- a/library/library.mli
+++ b/library/library.mli
@@ -37,9 +37,9 @@ type seg_proofs = Term.constr Future.computation array
    an export otherwise just a simple import *)
 val import_module : bool -> qualid located list -> unit
 
-(** Start the compilation of a file as a library. The argument must be an
-    existing file on the system, and the returned path is the associated
-    absolute logical path of the library. *)
+(** Start the compilation of a file as a library. The first argument must be
+    output file, and the 
+    returned path is the associated absolute logical path of the library. *)
 val start_library : CUnix.physical_path -> DirPath.t
 
 (** End the compilation of a library and save it to a ".vo" file *)
diff --git a/library/library.mllib b/library/library.mllib
index 920657365..df4f73503 100644
--- a/library/library.mllib
+++ b/library/library.mllib
@@ -5,7 +5,6 @@ Libobject
 Summary
 Nametab
 Global
-Universes
 Lib
 Declaremods
 Loadpath
diff --git a/library/loadpath.ml b/library/loadpath.ml
index 33c0f41e1..d03c6c555 100644
--- a/library/loadpath.ml
+++ b/library/loadpath.ml
@@ -8,7 +8,7 @@
 
 open Pp
 open Util
-open Errors
+open CErrors
 open Names
 open Libnames
 
@@ -50,6 +50,13 @@ let remove_load_path dir =
   let filter p = not (String.equal p.path_physical dir) in
   load_paths := List.filter filter !load_paths
 
+let warn_overriding_logical_loadpath =
+  CWarnings.create ~name:"overriding-logical-loadpath" ~category:"loadpath"
+         (fun (phys_path, old_path, coq_path) ->
+          str phys_path ++ strbrk " was previously bound to " ++
+            pr_dirpath old_path ++ strbrk "; it is remapped to " ++
+            pr_dirpath coq_path)
+
 let add_load_path phys_path coq_path ~implicit =
   let phys_path = CUnix.canonical_path_name phys_path in
   let filter p = String.equal p.path_physical phys_path in
@@ -65,17 +72,12 @@ let add_load_path phys_path coq_path ~implicit =
     let replace =
       if DirPath.equal coq_path old_path then
         implicit <> old_implicit
-      else if DirPath.equal coq_path (Nameops.default_root_prefix)
-              && String.equal phys_path (CUnix.canonical_path_name Filename.current_dir_name) then
-        false (* This is the default "-I ." path, don't override the old path *)
       else
         let () =
           (* Do not warn when overriding the default "-I ." path *)
           if not (DirPath.equal old_path Nameops.default_root_prefix) then
-            Feedback.msg_warning
-              (str phys_path ++ strbrk " was previously bound to " ++
-                 pr_dirpath old_path ++ strbrk "; it is remapped to " ++
-                 pr_dirpath coq_path) in
+          warn_overriding_logical_loadpath (phys_path, old_path, coq_path)
+        in
         true in
     if replace then
       begin
diff --git a/library/nameops.ml b/library/nameops.ml
index 71405d024..6020db33d 100644
--- a/library/nameops.ml
+++ b/library/nameops.ml
@@ -67,9 +67,21 @@ let root_of_id id =
   let suffixstart = cut_ident true id in
   Id.of_string (String.sub (Id.to_string id) 0 suffixstart)
 
-(* Rem: semantics is a bit different, if an ident starts with toto00 then
-  after successive renamings it comes to toto09, then it goes on with toto10 *)
-let lift_subscript id =
+(* Return the same identifier as the original one but whose {i subscript} is incremented.
+   If the original identifier does not have a suffix, [0] is appended to it.
+
+   Example mappings:
+
+   [bar]   ↦ [bar0]
+   [bar0]  ↦ [bar1]
+   [bar00] ↦ [bar01]
+   [bar1]  ↦ [bar2]
+   [bar01] ↦ [bar01]
+   [bar9]  ↦ [bar10]
+   [bar09] ↦ [bar10]
+   [bar99] ↦ [bar100]
+*)
+let increment_subscript id =
   let id = Id.to_string id in
   let len = String.length id in
   let rec add carrypos =
diff --git a/library/nameops.mli b/library/nameops.mli
index 39ce409bc..3a67b61a1 100644
--- a/library/nameops.mli
+++ b/library/nameops.mli
@@ -21,9 +21,34 @@ val root_of_id : Id.t -> Id.t (** remove trailing digits, ' and _ *)
 val add_suffix : Id.t -> string -> Id.t
 val add_prefix : string -> Id.t -> Id.t
 
-val has_subscript    : Id.t -> bool
-val lift_subscript   : Id.t -> Id.t
-val forget_subscript : Id.t -> Id.t
+(** Below, by {i subscript} we mean a suffix composed solely from (decimal) digits. *)
+
+val has_subscript       : Id.t -> bool
+
+val increment_subscript : Id.t -> Id.t
+(** Return the same identifier as the original one but whose {i subscript} is incremented.
+    If the original identifier does not have a suffix, [0] is appended to it.
+
+    Example mappings:
+
+    [bar]   ↦ [bar0]
+
+    [bar0]  ↦ [bar1]
+
+    [bar00] ↦ [bar01]
+
+    [bar1]  ↦ [bar2]
+
+    [bar01] ↦ [bar01]
+
+    [bar9]  ↦ [bar10]
+
+    [bar09] ↦ [bar10]
+
+    [bar99] ↦ [bar100]
+*)
+
+val forget_subscript    : Id.t -> Id.t
 
 val out_name : Name.t -> Id.t
 (** [out_name] associates [id] to [Name id]. Raises [Failure "Nameops.out_name"]
diff --git a/library/nametab.ml b/library/nametab.ml
index db902d625..b76048e89 100644
--- a/library/nametab.ml
+++ b/library/nametab.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-open Errors
+open CErrors
 open Util
 open Pp
 open Names
@@ -16,10 +16,8 @@ open Globnames
 
 exception GlobalizationError of qualid
 
-let error_global_not_found_loc loc q =
-  Loc.raise loc (GlobalizationError q)
-
-let error_global_not_found q = raise (GlobalizationError q)
+let error_global_not_found ?loc q =
+  Loc.raise ?loc (GlobalizationError q)
 
 (* Kinds of global names *)
 
@@ -82,6 +80,14 @@ module Make (U : UserName) (E : EqualityType) : NAMETREE
 struct
   type elt = E.t
 
+  (* A name became inaccessible, even with absolute qualification.
+     Example:
+     Module F (X : S). Module X.
+     The argument X of the functor F is masked by the inner module X.
+   *)
+  let masking_absolute n =
+    Flags.if_verbose Feedback.msg_info (str ("Trying to mask the absolute name \"" ^ U.to_string n ^ "\"!"))
+
   type user_name = U.t
 
   type path_status =
@@ -119,9 +125,7 @@ struct
 	      | Absolute (n,_) ->
 		  (* This is an absolute name, we must keep it
 		     otherwise it may become unaccessible forever *)
-		    Feedback.msg_warning (str ("Trying to mask the absolute name \""
-			     ^ U.to_string n ^ "\"!"));
-		  tree.path
+                masking_absolute n; tree.path
 	      | Nothing
 	      | Relative _ -> Relative (uname,o)
           else tree.path
@@ -144,7 +148,6 @@ struct
 	  | Nothing
 	  | Relative _ -> mktree (Absolute (uname,o)) tree.map
 
-
 let rec push_exactly uname o level tree = function
 | [] ->
   anomaly (Pp.str "Prefix longer than path! Impossible!")
@@ -155,9 +158,7 @@ let rec push_exactly uname o level tree = function
         | Absolute (n,_) ->
             (* This is an absolute name, we must keep it
                 otherwise it may become unaccessible forever *)
-              Feedback.msg_warning (str ("Trying to mask the absolute name \""
-                        ^ U.to_string n ^ "\"!"));
-            tree.path
+            masking_absolute n; tree.path
         | Nothing
         | Relative _ -> Relative (uname,o)
     in
@@ -452,11 +453,11 @@ let global r =
   try match locate_extended qid with
     | TrueGlobal ref -> ref
     | SynDef _ ->
-        user_err_loc (loc,"global",
-          str "Unexpected reference to a notation: " ++
-          pr_qualid qid)
+        user_err ~loc ~hdr:"global"
+          (str "Unexpected reference to a notation: " ++
+           pr_qualid qid)
   with Not_found ->
-    error_global_not_found_loc loc qid
+    error_global_not_found ~loc qid
 
 (* Exists functions ********************************************************)
 
@@ -531,8 +532,8 @@ let global_inductive r =
   match global r with
   | IndRef ind -> ind
   | ref ->
-      user_err_loc (loc_of_reference r,"global_inductive",
-        pr_reference r ++ spc () ++ str "is not an inductive type")
+      user_err ~loc:(loc_of_reference r) ~hdr:"global_inductive"
+        (pr_reference r ++ spc () ++ str "is not an inductive type")
 
 
 (********************************************************************)
diff --git a/library/nametab.mli b/library/nametab.mli
index a8a0572b3..d20c399b6 100644
--- a/library/nametab.mli
+++ b/library/nametab.mli
@@ -60,8 +60,7 @@ open Globnames
 exception GlobalizationError of qualid
 
 (** Raises a globalization error *)
-val error_global_not_found_loc : Loc.t -> qualid -> 'a
-val error_global_not_found     : qualid -> 'a
+val error_global_not_found : ?loc:Loc.t -> qualid -> 'a
 
 (** {6 Register visibility of things } *)
 
diff --git a/library/states.ml b/library/states.ml
index 2e1be764a..95bd819d6 100644
--- a/library/states.ml
+++ b/library/states.ml
@@ -35,7 +35,7 @@ let with_state_protection f x =
   try
     let a = f x in unfreeze st; a
   with reraise ->
-    let reraise = Errors.push reraise in
+    let reraise = CErrors.push reraise in
     (unfreeze st; iraise reraise)
 
 let with_state_protection_on_exception = Future.transactify
diff --git a/library/summary.ml b/library/summary.ml
index edea7dbe5..6efa07f38 100644
--- a/library/summary.ml
+++ b/library/summary.ml
@@ -7,7 +7,7 @@
 (************************************************************************)
 
 open Pp
-open Errors
+open CErrors
 open Util
 
 module Dyn = Dyn.Make(struct end)
@@ -105,10 +105,10 @@ let unfreeze_summaries fs =
   in
   let fold id decl state =
     try fold id decl state
-    with e when Errors.noncritical e ->
-      let e = Errors.push e in
+    with e when CErrors.noncritical e ->
+      let e = CErrors.push e in
       Printf.eprintf "Error unfrezing summay %s\n%s\n%!"
-        (name_of_summary id) (Pp.string_of_ppcmds (Errors.iprint e));
+        (name_of_summary id) (Pp.string_of_ppcmds (CErrors.iprint e));
       iraise e
   in
   (** We rely on the order of the frozen list, and the order of folding *)
@@ -149,7 +149,7 @@ let unfreeze_summary datas =
       let (name, summary) = Int.Map.find id !summaries in
       try summary.unfreeze_function data
       with e ->
-        let e = Errors.push e in
+        let e = CErrors.push e in
         prerr_endline ("Exception unfreezing " ^ name);
         iraise e)
   datas
@@ -186,4 +186,29 @@ let ref ?(freeze=fun _ r -> r) ~name x =
       init_function = (fun () -> r := x) };
   r
 
+module Local = struct
+
+type 'a local_ref = ('a CEphemeron.key * string) ref
+
+let (:=) r v = r := (CEphemeron.create v, snd !r)
+
+let (!) r =
+  let key, name = !r in
+  try CEphemeron.get key
+  with CEphemeron.InvalidKey ->
+    let _, { init_function } =
+      Int.Map.find (String.hash (mangle name)) !summaries in
+    init_function ();
+    CEphemeron.get (fst !r)
+
+let ref ?(freeze=fun x -> x) ~name init =
+  let r = Pervasives.ref (CEphemeron.create init, name) in
+  declare_summary name
+    { freeze_function = (fun _ -> freeze !r);
+      unfreeze_function = ((:=) r);
+      init_function = (fun () -> r := init) };
+  r
+
+end
+
 let dump = Dyn.dump
diff --git a/library/summary.mli b/library/summary.mli
index 27889cab2..1b57613cb 100644
--- a/library/summary.mli
+++ b/library/summary.mli
@@ -42,6 +42,17 @@ val declare_summary : string -> 'a summary_declaration -> unit
 
 val ref : ?freeze:(marshallable -> 'a -> 'a) -> name:string -> 'a -> 'a ref
 
+(* As [ref] but the value is local to a process, i.e. not sent to, say, proof
+ * workers.  It is useful to implement a local cache for example. *)
+module Local : sig
+
+  type 'a local_ref
+  val ref : ?freeze:('a -> 'a) -> name:string -> 'a -> 'a local_ref
+  val (:=) : 'a local_ref -> 'a -> unit
+  val (!) : 'a local_ref -> 'a
+
+end
+
 (** Special name for the summary of ML modules.  This summary entry is
     special because its unfreeze may load ML code and hence add summary
     entries.  Thus is has to be recognizable, and handled appropriately *)
diff --git a/ltac/coretactics.ml4 b/ltac/coretactics.ml4
index ce28eacc0..28ff6df83 100644
--- a/ltac/coretactics.ml4
+++ b/ltac/coretactics.ml4
@@ -13,7 +13,7 @@ open Names
 open Locus
 open Misctypes
 open Genredexpr
-open Constrarg
+open Stdarg
 open Extraargs
 
 open Sigma.Notations
@@ -26,6 +26,10 @@ TACTIC EXTEND reflexivity
   [ "reflexivity" ] -> [ Tactics.intros_reflexivity ]
 END
 
+TACTIC EXTEND exact
+  [ "exact" casted_constr(c) ] -> [ Tactics.exact_no_check c ]
+END
+
 TACTIC EXTEND assumption
   [ "assumption" ] -> [ Tactics.assumption ]
 END
@@ -138,13 +142,19 @@ END
 
 TACTIC EXTEND specialize
   [ "specialize" constr_with_bindings(c) ] -> [
-    Tacticals.New.tclDELAYEDWITHHOLES false c Tactics.specialize
+    Tacticals.New.tclDELAYEDWITHHOLES false c (fun c -> Tactics.specialize c None)
+  ]
+| [ "specialize" constr_with_bindings(c) "as" intropattern(ipat) ] -> [
+    Tacticals.New.tclDELAYEDWITHHOLES false c (fun c -> Tactics.specialize c (Some ipat))
   ]
 END
 
 TACTIC EXTEND symmetry
   [ "symmetry" ] -> [ Tactics.intros_symmetry {onhyps=Some[];concl_occs=AllOccurrences} ]
-| [ "symmetry" clause_dft_concl(cl) ] -> [ Tactics.intros_symmetry cl ]
+END
+
+TACTIC EXTEND symmetry_in
+| [ "symmetry" "in" in_clause(cl) ] -> [ Tactics.intros_symmetry cl ]
 END
 
 (** Split *)
@@ -197,6 +207,19 @@ TACTIC EXTEND intros_until
   [ "intros" "until" quantified_hypothesis(h) ] -> [ Tactics.intros_until h ]
 END
 
+TACTIC EXTEND intro
+| [ "intro" ] -> [ Tactics.intro_move None MoveLast ]
+| [ "intro" ident(id) ] -> [ Tactics.intro_move (Some id) MoveLast ]
+| [ "intro" ident(id) "at" "top" ] -> [ Tactics.intro_move (Some id) MoveFirst ]
+| [ "intro" ident(id) "at" "bottom" ] -> [ Tactics.intro_move (Some id) MoveLast ]
+| [ "intro" ident(id) "after" hyp(h) ] -> [ Tactics.intro_move (Some id) (MoveAfter h) ]
+| [ "intro" ident(id) "before" hyp(h) ] -> [ Tactics.intro_move (Some id) (MoveBefore h) ]
+| [ "intro" "at" "top" ] -> [ Tactics.intro_move None MoveFirst ]
+| [ "intro" "at" "bottom" ] -> [ Tactics.intro_move None MoveLast ]
+| [ "intro" "after" hyp(h) ] -> [ Tactics.intro_move None (MoveAfter h) ]
+| [ "intro" "before" hyp(h) ] -> [ Tactics.intro_move None (MoveBefore h) ]
+END
+
 (** Move *)
 
 TACTIC EXTEND move
@@ -206,6 +229,12 @@ TACTIC EXTEND move
 | [ "move" hyp(id) "before" hyp(h) ] -> [ Tactics.move_hyp id (MoveBefore h) ]
 END
 
+(** Rename *)
+
+TACTIC EXTEND rename
+| [ "rename" ne_rename_list_sep(ids, ",") ] -> [ Tactics.rename_hyp ids ]
+END
+
 (** Revert *)
 
 TACTIC EXTEND revert
@@ -222,6 +251,13 @@ TACTIC EXTEND simple_destruct
   [ "simple" "destruct" quantified_hypothesis(h) ] -> [ Tactics.simple_destruct h ]
 END
 
+(** Double induction *)
+
+TACTIC EXTEND double_induction
+  [ "double" "induction" quantified_hypothesis(h1) quantified_hypothesis(h2) ] ->
+  [ Elim.h_double_induction h1 h2 ]
+END
+
 (* Admit *)
 
 TACTIC EXTEND admit
@@ -280,8 +316,7 @@ let initial_atomic () =
         "hnf", TacReduce(Hnf,nocl);
         "simpl", TacReduce(Simpl (Redops.all_flags,None),nocl);
         "compute", TacReduce(Cbv Redops.all_flags,nocl);
-        "intro", TacIntroMove(None,MoveLast);
-        "intros", TacIntroPattern [];
+        "intros", TacIntroPattern (false,[]);
       ]
   in
   let iter (s, t) = Tacenv.register_ltac false false (Id.of_string s) t in
diff --git a/ltac/evar_tactics.ml b/ltac/evar_tactics.ml
index 2e0996bf5..c5b26e6d5 100644
--- a/ltac/evar_tactics.ml
+++ b/ltac/evar_tactics.ml
@@ -7,7 +7,7 @@
 (************************************************************************)
 
 open Util
-open Errors
+open CErrors
 open Evar_refiner
 open Tacmach
 open Tacexpr
@@ -18,6 +18,8 @@ open Sigma.Notations
 open Proofview.Notations
 open Context.Named.Declaration
 
+module NamedDecl = Context.Named.Declaration
+
 (* The instantiate tactic *)
 
 let instantiate_evar evk (ist,rawc) sigma =
@@ -48,7 +50,7 @@ let instantiate_tac n c ido =
 		    | _ -> error
 			"Please be more specific: in type or value?")
 	      | InHypTypeOnly ->
-		  evar_list (get_type decl)
+		  evar_list (NamedDecl.get_type decl)
 	      | InHypValueOnly ->
 		  (match decl with
 		    | LocalDef (_,body,_) -> evar_list body
diff --git a/ltac/extraargs.ml4 b/ltac/extraargs.ml4
index 0bddcc9fd..53b726432 100644
--- a/ltac/extraargs.ml4
+++ b/ltac/extraargs.ml4
@@ -11,10 +11,11 @@
 open Pp
 open Genarg
 open Stdarg
-open Constrarg
+open Tacarg
 open Pcoq.Prim
 open Pcoq.Constr
 open Names
+open Tacmach
 open Tacexpr
 open Taccoerce
 open Tacinterp
@@ -30,15 +31,15 @@ let create_generic_quotation name e wit =
 let () = create_generic_quotation "integer" Pcoq.Prim.integer Stdarg.wit_int
 let () = create_generic_quotation "string" Pcoq.Prim.string Stdarg.wit_string
 
-let () = create_generic_quotation "ident" Pcoq.Prim.ident Constrarg.wit_ident
-let () = create_generic_quotation "reference" Pcoq.Prim.reference Constrarg.wit_ref
-let () = create_generic_quotation "uconstr" Pcoq.Constr.lconstr Constrarg.wit_uconstr
-let () = create_generic_quotation "constr" Pcoq.Constr.lconstr Constrarg.wit_constr
-let () = create_generic_quotation "ipattern" Pcoq.Tactic.simple_intropattern Constrarg.wit_intro_pattern
-let () = create_generic_quotation "open_constr" Pcoq.Constr.lconstr Constrarg.wit_open_constr
+let () = create_generic_quotation "ident" Pcoq.Prim.ident Stdarg.wit_ident
+let () = create_generic_quotation "reference" Pcoq.Prim.reference Stdarg.wit_ref
+let () = create_generic_quotation "uconstr" Pcoq.Constr.lconstr Stdarg.wit_uconstr
+let () = create_generic_quotation "constr" Pcoq.Constr.lconstr Stdarg.wit_constr
+let () = create_generic_quotation "ipattern" Pltac.simple_intropattern Stdarg.wit_intro_pattern
+let () = create_generic_quotation "open_constr" Pcoq.Constr.lconstr Stdarg.wit_open_constr
 let () =
   let inject (loc, v) = Tacexpr.Tacexp v in
-  Tacentries.create_ltac_quotation "ltac" inject (Pcoq.Tactic.tactic_expr, Some 5)
+  Tacentries.create_ltac_quotation "ltac" inject (Pltac.tactic_expr, Some 5)
 
 (** Backward-compatible tactic notation entry names *)
 
@@ -89,7 +90,7 @@ let occurrences_of = function
   | n::_ as nl when n < 0 -> AllOccurrencesBut (List.map abs nl)
   | nl ->
       if List.exists (fun n -> n < 0) nl then
-        Errors.error "Illegal negative occurrence number.";
+        CErrors.error "Illegal negative occurrence number.";
       OnlyOccurrences nl
 
 let coerce_to_int v = match Value.to_int v with
@@ -175,6 +176,16 @@ ARGUMENT EXTEND lglob
   [ lconstr(c) ] -> [ c ]
 END
 
+let interp_casted_constr ist gl c =
+  interp_constr_gen (Pretyping.OfType (pf_concl gl)) ist (pf_env gl) (project gl) c
+
+ARGUMENT EXTEND casted_constr
+  TYPED AS constr
+  PRINTED BY pr_gen
+  INTERPRETED BY interp_casted_constr
+  [ constr(c) ] -> [ c ]
+END
+
 type 'id gen_place= ('id * hyp_location_flag,unit) location
 
 type loc_place = Id.t Loc.located gen_place
@@ -225,6 +236,14 @@ ARGUMENT EXTEND hloc
 
  END
 
+let pr_rename _ _ _ (n, m) = Nameops.pr_id n ++ str " into " ++ Nameops.pr_id m
+
+ARGUMENT EXTEND rename
+  TYPED AS ident * ident
+  PRINTED BY pr_rename
+| [ ident(n) "into" ident(m) ] -> [ (n, m) ]
+END
+
 (* Julien: Mise en commun des differentes version de replace with in by *)
 
 let pr_by_arg_tac _prc _prlc prtac opt_c =
@@ -241,6 +260,20 @@ END
 
 let pr_by_arg_tac prtac opt_c = pr_by_arg_tac () () prtac opt_c
 
+let pr_in_clause _ _ _ cl = Pptactic.pr_in_clause Ppconstr.pr_lident cl
+let pr_in_top_clause _ _ _ cl = Pptactic.pr_in_clause Id.print cl
+let in_clause' = Pltac.in_clause
+
+ARGUMENT EXTEND in_clause
+  TYPED AS clause_dft_concl
+  PRINTED BY pr_in_top_clause
+  RAW_TYPED AS clause_dft_concl
+  RAW_PRINTED BY pr_in_clause
+  GLOB_TYPED AS clause_dft_concl
+  GLOB_PRINTED BY pr_in_clause
+| [ in_clause'(cl) ] -> [ cl ]
+END
+
 (* spiwack: the print functions are incomplete, but I don't know what they are
 	used for *)
 let pr_r_nat_field natf =
@@ -273,7 +306,23 @@ let pr_r_int31_field i31f =
     | Retroknowledge.Int31PhiInv -> str "phi inv"
     | Retroknowledge.Int31Plus -> str "plus"
     | Retroknowledge.Int31Times -> str "times"
-    | _ -> assert false
+    | Retroknowledge.Int31Constructor -> assert false
+    | Retroknowledge.Int31PlusC -> str "plusc"
+    | Retroknowledge.Int31PlusCarryC -> str "pluscarryc"
+    | Retroknowledge.Int31Minus -> str "minus"
+    | Retroknowledge.Int31MinusC -> str "minusc"
+    | Retroknowledge.Int31MinusCarryC -> str "minuscarryc"
+    | Retroknowledge.Int31TimesC -> str "timesc"
+    | Retroknowledge.Int31Div21 -> str "div21"
+    | Retroknowledge.Int31Div -> str "div"
+    | Retroknowledge.Int31Diveucl -> str "diveucl"
+    | Retroknowledge.Int31AddMulDiv -> str "addmuldiv"
+    | Retroknowledge.Int31Compare -> str "compare"
+    | Retroknowledge.Int31Head0 -> str "head0"
+    | Retroknowledge.Int31Tail0 -> str "tail0"
+    | Retroknowledge.Int31Lor -> str "lor"
+    | Retroknowledge.Int31Land -> str "land"
+    | Retroknowledge.Int31Lxor -> str "lxor"
 
 let pr_retroknowledge_field f =
   match f with
@@ -281,7 +330,7 @@ let pr_retroknowledge_field f =
   | Retroknowledge.KNat natf -> pr_r_nat_field () () () natf
   | Retroknowledge.KN nf -> pr_r_n_field () () () nf *)
   | Retroknowledge.KInt31 (group, i31f) -> (pr_r_int31_field i31f) ++
-                                           str "in " ++ str group
+                                           spc () ++ str "in " ++ qs group
 
 VERNAC ARGUMENT EXTEND retroknowledge_nat
 PRINTED BY pr_r_nat_field
diff --git a/ltac/extraargs.mli b/ltac/extraargs.mli
index 4d1d8ba7f..b12187e18 100644
--- a/ltac/extraargs.mli
+++ b/ltac/extraargs.mli
@@ -16,6 +16,8 @@ val wit_orient : bool Genarg.uniform_genarg_type
 val orient : bool Pcoq.Gram.entry
 val pr_orient : bool -> Pp.std_ppcmds
 
+val wit_rename : (Id.t * Id.t) Genarg.uniform_genarg_type
+
 val occurrences : (int list or_var) Pcoq.Gram.entry
 val wit_occurrences : (int list or_var, int list or_var, int list) Genarg.genarg_type
 val pr_occurrences : int list or_var -> Pp.std_ppcmds
@@ -38,6 +40,11 @@ val wit_lconstr :
   Tacexpr.glob_constr_and_expr,
   Constr.t) Genarg.genarg_type
 
+val wit_casted_constr :
+  (constr_expr,
+  Tacexpr.glob_constr_and_expr,
+  Constr.t) Genarg.genarg_type
+
 val glob : constr_expr Pcoq.Gram.entry
 val lglob : constr_expr Pcoq.Gram.entry
 
@@ -64,3 +71,8 @@ val pr_by_arg_tac :
 
 val retroknowledge_field : Retroknowledge.field Pcoq.Gram.entry
 val wit_retroknowledge_field : (Retroknowledge.field, unit, unit) Genarg.genarg_type
+
+val wit_in_clause :
+  (Id.t Loc.located Locus.clause_expr,
+  Id.t Loc.located Locus.clause_expr,
+  Id.t Locus.clause_expr) Genarg.genarg_type
diff --git a/ltac/extratactics.ml4 b/ltac/extratactics.ml4
index 5d3c149ab..1223f6eb4 100644
--- a/ltac/extratactics.ml4
+++ b/ltac/extratactics.ml4
@@ -11,15 +11,15 @@
 open Pp
 open Genarg
 open Stdarg
-open Constrarg
+open Tacarg
 open Extraargs
 open Pcoq.Prim
-open Pcoq.Tactic
+open Pltac
 open Mod_subst
 open Names
 open Tacexpr
 open Glob_ops
-open Errors
+open CErrors
 open Util
 open Evd
 open Termops
@@ -37,7 +37,7 @@ DECLARE PLUGIN "extratactics"
 let with_delayed_uconstr ist c tac =
   let flags = {
     Pretyping.use_typeclasses = false;
-    use_unif_heuristics = true;
+    solve_unification_constraints = true;
     use_hook = Some Pfedit.solve_by_implicit_tactic;
     fail_evar = false;
     expand_evars = true
@@ -52,7 +52,7 @@ let replace_in_clause_maybe_by ist c1 c2 cl tac =
 let replace_term ist dir_opt c cl =
   with_delayed_uconstr ist c (fun c -> replace_term dir_opt c cl)
 
-let clause = Pcoq.Tactic.clause_dft_concl
+let clause = Pltac.clause_dft_concl
 
 TACTIC EXTEND replace
    ["replace" uconstr(c1) "with" constr(c2) clause(cl) by_arg_tac(tac) ]
@@ -82,98 +82,75 @@ let induction_arg_of_quantified_hyp = function
    ElimOnAnonHyp and not as a "constr", and "id" is interpreted as a
    ElimOnIdent and not as "constr" *)
 
+let mytclWithHoles tac with_evars c =
+  Proofview.Goal.enter { enter = begin fun gl ->
+    let env = Tacmach.New.pf_env gl in
+    let sigma = Tacmach.New.project gl in
+    let sigma',c = Tactics.force_destruction_arg with_evars env sigma c in
+    Tacticals.New.tclWITHHOLES with_evars (tac with_evars (Some c)) sigma'
+  end }
+
 let elimOnConstrWithHoles tac with_evars c =
   Tacticals.New.tclDELAYEDWITHHOLES with_evars c
     (fun c -> tac with_evars (Some (None,ElimOnConstr c)))
 
-TACTIC EXTEND simplify_eq_main
-| [ "simplify_eq" constr_with_bindings(c) ] ->
-    [ elimOnConstrWithHoles dEq false c ]
-END
 TACTIC EXTEND simplify_eq
   [ "simplify_eq" ] -> [ dEq false None ]
-| [ "simplify_eq" quantified_hypothesis(h) ] ->
-    [ dEq false (Some (induction_arg_of_quantified_hyp h)) ]
-END
-TACTIC EXTEND esimplify_eq_main
-| [ "esimplify_eq" constr_with_bindings(c) ] ->
-    [ elimOnConstrWithHoles dEq true c ]
+| [ "simplify_eq" destruction_arg(c) ] -> [ mytclWithHoles dEq false c ]
 END
 TACTIC EXTEND esimplify_eq
 | [ "esimplify_eq" ] -> [ dEq true None ]
-| [ "esimplify_eq" quantified_hypothesis(h) ] ->
-    [ dEq true (Some (induction_arg_of_quantified_hyp h)) ]
+| [ "esimplify_eq" destruction_arg(c) ] -> [ mytclWithHoles dEq true c ]
 END
 
 let discr_main c = elimOnConstrWithHoles discr_tac false c
 
-TACTIC EXTEND discriminate_main
-| [ "discriminate" constr_with_bindings(c) ] ->
-    [ discr_main c ]
-END
 TACTIC EXTEND discriminate
 | [ "discriminate" ] -> [ discr_tac false None ]
-| [ "discriminate" quantified_hypothesis(h) ] ->
-    [ discr_tac false (Some (induction_arg_of_quantified_hyp h)) ]
-END
-TACTIC EXTEND ediscriminate_main
-| [ "ediscriminate" constr_with_bindings(c) ] ->
-    [ elimOnConstrWithHoles discr_tac true c ]
+| [ "discriminate" destruction_arg(c) ] ->
+    [ mytclWithHoles discr_tac false c ]
 END
 TACTIC EXTEND ediscriminate
 | [ "ediscriminate" ] -> [ discr_tac true None ]
-| [ "ediscriminate" quantified_hypothesis(h) ] ->
-    [ discr_tac true (Some (induction_arg_of_quantified_hyp h)) ]
+| [ "ediscriminate" destruction_arg(c) ] ->
+    [ mytclWithHoles discr_tac true c ]
 END
 
 let discrHyp id =
   Proofview.tclEVARMAP >>= fun sigma ->
   discr_main { delayed = fun env sigma -> Sigma.here (Term.mkVar id, NoBindings) sigma }
 
-let injection_main c =
- elimOnConstrWithHoles (injClause None) false c
+let injection_main with_evars c =
+ elimOnConstrWithHoles (injClause None) with_evars c
 
-TACTIC EXTEND injection_main
-| [ "injection" constr_with_bindings(c) ] ->
-    [ injection_main c ]
-END
 TACTIC EXTEND injection
 | [ "injection" ] -> [ injClause None false None ]
-| [ "injection" quantified_hypothesis(h) ] ->
-    [ injClause None false (Some (induction_arg_of_quantified_hyp h)) ]
-END
-TACTIC EXTEND einjection_main
-| [ "einjection" constr_with_bindings(c) ] ->
-    [ elimOnConstrWithHoles (injClause None) true c ]
+| [ "injection" destruction_arg(c) ] -> [ mytclWithHoles (injClause None) false c ]
 END
 TACTIC EXTEND einjection
 | [ "einjection" ] -> [ injClause None true None ]
-| [ "einjection" quantified_hypothesis(h) ] -> [ injClause None true (Some (induction_arg_of_quantified_hyp h)) ]
-END
-TACTIC EXTEND injection_as_main
-| [ "injection" constr_with_bindings(c) "as" intropattern_list(ipat)] ->
-    [ elimOnConstrWithHoles (injClause (Some ipat)) false c ]
+| [ "einjection" destruction_arg(c) ] -> [ mytclWithHoles (injClause None) true c ]
 END
 TACTIC EXTEND injection_as
 | [ "injection" "as" intropattern_list(ipat)] ->
     [ injClause (Some ipat) false None ]
-| [ "injection" quantified_hypothesis(h) "as" intropattern_list(ipat) ] ->
-    [ injClause (Some ipat) false (Some (induction_arg_of_quantified_hyp h)) ]
-END
-TACTIC EXTEND einjection_as_main
-| [ "einjection" constr_with_bindings(c) "as" intropattern_list(ipat)] ->
-    [ elimOnConstrWithHoles (injClause (Some ipat)) true c ]
+| [ "injection" destruction_arg(c) "as" intropattern_list(ipat)] ->
+    [ mytclWithHoles (injClause (Some ipat)) false c ]
 END
 TACTIC EXTEND einjection_as
 | [ "einjection" "as" intropattern_list(ipat)] ->
     [ injClause (Some ipat) true None ]
-| [ "einjection" quantified_hypothesis(h) "as" intropattern_list(ipat) ] ->
-    [ injClause (Some ipat) true (Some (induction_arg_of_quantified_hyp h)) ]
+| [ "einjection" destruction_arg(c) "as" intropattern_list(ipat)] ->
+    [ mytclWithHoles (injClause (Some ipat)) true c ]
+END
+TACTIC EXTEND simple_injection
+| [ "simple" "injection" ] -> [ simpleInjClause false None ]
+| [ "simple" "injection" destruction_arg(c) ] -> [ mytclWithHoles simpleInjClause false c ]
 END
 
 let injHyp id =
   Proofview.tclEVARMAP >>= fun sigma ->
-  injection_main { delayed = fun env sigma -> Sigma.here (Term.mkVar id, NoBindings) sigma }
+  injection_main false { delayed = fun env sigma -> Sigma.here (Term.mkVar id, NoBindings) sigma }
 
 TACTIC EXTEND dependent_rewrite
 | [ "dependent" "rewrite" orient(b) constr(c) ] -> [ rewriteInConcl b c ]
@@ -285,7 +262,10 @@ let add_rewrite_hint bases ort t lcsr =
     let ctx =
       let ctx = UState.context_set ctx in
         if poly then ctx
-	else (Global.push_context_set false ctx; Univ.ContextSet.empty)
+	else (** This is a global universe context that shouldn't be
+	       refreshed at every use of the hint, declare it globally. *)
+	  (Declare.declare_universe_context false ctx;
+           Univ.ContextSet.empty)
     in
       Constrexpr_ops.constr_loc ce, (c, ctx), ort, Option.map (in_gen (rawwit wit_ltac)) t in
   let eqs = List.map f lcsr in
@@ -335,10 +315,12 @@ let project_hint pri l2r r =
   in
   let ctx = Evd.universe_context_set sigma in
   let c = Declare.declare_definition ~internal:Declare.InternalTacticRequest id (c,ctx) in
-    (pri,false,true,Hints.PathAny, Hints.IsGlobRef (Globnames.ConstRef c))
+  let info = {Vernacexpr.hint_priority = pri; hint_pattern = None} in
+    (info,false,true,Hints.PathAny, Hints.IsGlobRef (Globnames.ConstRef c))
 
 let add_hints_iff l2r lc n bl =
-  Hints.add_hints true bl
+  let l = Locality.LocalityFixme.consume () in
+  Hints.add_hints (Locality.make_module_locality l) bl
     (Hints.HintsResolveEntry (List.map (project_hint n l2r) lc))
 
 VERNAC COMMAND EXTEND HintResolveIffLR CLASSIFIED AS SIDEFF
@@ -359,15 +341,23 @@ END
 (**********************************************************************)
 (* Refine                                                             *)
 
-let refine_tac ist simple c =
+let constr_flags = {
+  Pretyping.use_typeclasses = true;
+  Pretyping.solve_unification_constraints = true;
+  Pretyping.use_hook = Some Pfedit.solve_by_implicit_tactic;
+  Pretyping.fail_evar = false;
+  Pretyping.expand_evars = true }
+
+let refine_tac ist simple with_classes c =
   Proofview.Goal.nf_enter { enter = begin fun gl ->
     let concl = Proofview.Goal.concl gl in
     let env = Proofview.Goal.env gl in
-    let flags = Pretyping.all_no_fail_flags in
+    let flags =
+      { constr_flags with Pretyping.use_typeclasses = with_classes } in
     let expected_type = Pretyping.OfType concl in
     let c = Pretyping.type_uconstr ~flags ~expected_type ist c in
     let update = { run = fun sigma -> c.delayed env sigma } in
-    let refine = Refine.refine ~unsafe:false update in
+    let refine = Refine.refine ~unsafe:true update in
     if simple then refine
     else refine <*>
            Tactics.New.reduce_after_refine <*>
@@ -375,11 +365,28 @@ let refine_tac ist simple c =
   end }
 
 TACTIC EXTEND refine
-| [ "refine" uconstr(c) ] -> [ refine_tac ist false c ]
+| [ "refine" uconstr(c) ] ->
+   [ refine_tac ist false true c ]
 END
 
 TACTIC EXTEND simple_refine
-| [ "simple" "refine" uconstr(c) ] -> [ refine_tac ist true c ]
+| [ "simple" "refine" uconstr(c) ] ->
+   [ refine_tac ist true true c ]
+END
+
+TACTIC EXTEND notcs_refine
+| [ "notypeclasses" "refine" uconstr(c) ] ->
+   [ refine_tac ist false false c ]
+END
+
+TACTIC EXTEND notcs_simple_refine
+| [ "simple" "notypeclasses" "refine" uconstr(c) ] ->
+   [ refine_tac ist true false c ]
+END
+
+(* Solve unification constraints using heuristics or fail if any remain *)
+TACTIC EXTEND solve_constraints
+[ "solve_constraints" ] -> [ Refine.solve_constraints ]
 END
 
 (**********************************************************************)
@@ -539,11 +546,29 @@ VERNAC COMMAND EXTEND AddStepr CLASSIFIED AS SIDEFF
     [ add_transitivity_lemma false t ]
 END
 
+let cache_implicit_tactic (_,tac) = match tac with
+  | Some tac -> Pfedit.declare_implicit_tactic (Tacinterp.eval_tactic tac)
+  | None -> Pfedit.clear_implicit_tactic ()
+
+let subst_implicit_tactic (subst,tac) =
+  Option.map (Tacsubst.subst_tactic subst) tac
+
+let inImplicitTactic : glob_tactic_expr option -> obj =
+  declare_object {(default_object "IMPLICIT-TACTIC") with
+       open_function = (fun i o -> if Int.equal i 1 then cache_implicit_tactic o);
+       cache_function = cache_implicit_tactic;
+       subst_function = subst_implicit_tactic;
+       classify_function = (fun o -> Dispose)}
+
+let declare_implicit_tactic tac =
+  Lib.add_anonymous_leaf (inImplicitTactic (Some (Tacintern.glob_tactic tac)))
+
+let clear_implicit_tactic () =
+  Lib.add_anonymous_leaf (inImplicitTactic None)
+
 VERNAC COMMAND EXTEND ImplicitTactic CLASSIFIED AS SIDEFF
-| [ "Declare" "Implicit" "Tactic" tactic(tac) ] ->
-    [ Pfedit.declare_implicit_tactic (Tacinterp.interp tac) ]
-| [ "Clear" "Implicit" "Tactic" ] ->
-    [ Pfedit.clear_implicit_tactic () ]
+| [ "Declare" "Implicit" "Tactic" tactic(tac) ] -> [ declare_implicit_tactic tac ]
+| [ "Clear" "Implicit" "Tactic" ] -> [ clear_implicit_tactic () ]
 END
 
 
@@ -644,7 +669,7 @@ let hResolve id c occ t =
       Pretyping.understand env sigma t_hole
     with
       | Pretype_errors.PretypeError (_,_,Pretype_errors.UnsolvableImplicit _) as e ->
-          let (e, info) = Errors.push e in
+          let (e, info) = CErrors.push e in
           let loc = match Loc.get_loc info with None -> Loc.ghost | Some loc -> loc in
           resolve_hole (subst_hole_with_term (fst (Loc.unloc loc)) c_raw t_hole)
   in
@@ -663,7 +688,7 @@ let hResolve_auto id c t =
       hResolve id c n t
     with
     | UserError _ as e -> raise e
-    | e when Errors.noncritical e -> resolve_auto (n+1)
+    | e when CErrors.noncritical e -> resolve_auto (n+1)
   in
   resolve_auto 1
 
@@ -813,9 +838,11 @@ END
 
 TACTIC EXTEND is_evar
 | [ "is_evar" constr(x) ] ->
-    [ match kind_of_term x with
+    [ Proofview.tclBIND Proofview.tclEVARMAP begin fun sigma ->
+      match Evarutil.kind_of_term_upto sigma x with
         | Evar _ -> Proofview.tclUNIT ()
         | _ -> Tacticals.New.tclFAIL 0 (str "Not an evar")
+      end
     ]
 END
 
@@ -866,13 +893,41 @@ TACTIC EXTEND is_cofix
     | _ -> Tacticals.New.tclFAIL 0 (Pp.str "not a cofix definition") ]
 END;;
 
+TACTIC EXTEND is_ind
+| [ "is_ind" constr(x) ] ->
+  [ match kind_of_term x with
+    | Ind _ -> Proofview.tclUNIT ()
+    | _ -> Tacticals.New.tclFAIL 0 (Pp.str "not an (co)inductive datatype") ]
+END;;
+
+TACTIC EXTEND is_constructor
+| [ "is_constructor" constr(x) ] ->
+  [ match kind_of_term x with
+    | Construct _ -> Proofview.tclUNIT ()
+    | _ -> Tacticals.New.tclFAIL 0 (Pp.str "not a constructor") ]
+END;;
+
+TACTIC EXTEND is_proj
+| [ "is_proj" constr(x) ] ->
+  [ match kind_of_term x with
+    | Proj _ -> Proofview.tclUNIT ()
+    | _ -> Tacticals.New.tclFAIL 0 (Pp.str "not a primitive projection") ]
+END;;
+
+TACTIC EXTEND is_const
+| [ "is_const" constr(x) ] ->
+  [ match kind_of_term x with
+    | Const _ -> Proofview.tclUNIT ()
+    | _ -> Tacticals.New.tclFAIL 0 (Pp.str "not a constant") ]
+END;;
+
 (* Command to grab the evars left unresolved at the end of a proof. *)
 (* spiwack: I put it in extratactics because it is somewhat tied with
    the semantics of the LCF-style tactics, hence with the classic tactic
    mode. *)
 VERNAC COMMAND EXTEND GrabEvars
 [ "Grab" "Existential" "Variables" ]
-  => [ Vernacexpr.VtProofStep false, Vernacexpr.VtLater ]
+  => [ Vernac_classifier.classify_as_proofstep ]
   -> [ Proof_global.simple_with_current_proof (fun _ p  -> Proof.V82.grab_evars p) ]
 END
 
@@ -903,7 +958,7 @@ END
 (* Command to add every unshelved variables to the focus *)
 VERNAC COMMAND EXTEND Unshelve
 [ "Unshelve" ]
-  => [ Vernacexpr.VtProofStep false, Vernacexpr.VtLater ]
+  => [ Vernac_classifier.classify_as_proofstep ]
   -> [ Proof_global.simple_with_current_proof (fun _ p  -> Proof.unshelve p) ]
 END
 
@@ -930,7 +985,6 @@ TACTIC EXTEND revgoals
 | [ "revgoals" ] -> [ Proofview.revgoals ]
 END
 
-
 type cmp =
   | Eq
   | Lt | Le
@@ -951,7 +1005,7 @@ let pr_cmp' _prc _prlc _prt = pr_cmp
 let pr_test_gen f (Test(c,x,y)) =
   Pp.(f x ++ pr_cmp c ++ f y)
 
-let pr_test = pr_test_gen (Pptactic.pr_or_var Pp.int)
+let pr_test = pr_test_gen (Pputils.pr_or_var Pp.int)
 
 let pr_test' _prc _prlc _prt = pr_test
 
diff --git a/ltac/g_auto.ml4 b/ltac/g_auto.ml4
index d4fd8a1df..a37cf306e 100644
--- a/ltac/g_auto.ml4
+++ b/ltac/g_auto.ml4
@@ -11,10 +11,10 @@
 open Pp
 open Genarg
 open Stdarg
-open Constrarg
 open Pcoq.Prim
 open Pcoq.Constr
-open Pcoq.Tactic
+open Pltac
+open Hints
 open Tacexpr
 
 DECLARE PLUGIN "g_auto"
@@ -43,18 +43,24 @@ END
 let eval_uconstrs ist cs =
   let flags = {
     Pretyping.use_typeclasses = false;
-    use_unif_heuristics = true;
+    solve_unification_constraints = true;
     use_hook = Some Pfedit.solve_by_implicit_tactic;
     fail_evar = false;
     expand_evars = true
   } in
   List.map (fun c -> Pretyping.type_uconstr ~flags ist c) cs
 
-let pr_auto_using _ _ _ = Pptactic.pr_auto_using (fun _ -> mt ())
+let pr_auto_using_raw _ _ _  = Pptactic.pr_auto_using Ppconstr.pr_constr_expr
+let pr_auto_using_glob _ _ _ = Pptactic.pr_auto_using (fun (c,_) -> Printer.pr_glob_constr c)
+let pr_auto_using _ _ _ = Pptactic.pr_auto_using Printer.pr_closed_glob
 
 ARGUMENT EXTEND auto_using
   TYPED AS uconstr_list
   PRINTED BY pr_auto_using
+  RAW_TYPED AS uconstr_list
+  RAW_PRINTED BY pr_auto_using_raw
+  GLOB_TYPED AS uconstr_list
+  GLOB_PRINTED BY pr_auto_using_glob
 | [ "using" ne_uconstr_list_sep(l, ",") ] -> [ l ]
 | [ ] -> [ [] ]
 END
@@ -171,29 +177,41 @@ TACTIC EXTEND convert_concl_no_check
 | ["convert_concl_no_check" constr(x) ] -> [ Tactics.convert_concl_no_check x Term.DEFAULTcast ]
 END
 
-let pr_hints_path_atom _ _ _ = Hints.pp_hints_path_atom
+let pr_pre_hints_path_atom _ _ _ = Hints.pp_hints_path_atom Libnames.pr_reference
+let pr_hints_path_atom _ _ _ = Hints.pp_hints_path_atom Printer.pr_global
+let glob_hints_path_atom ist = Hints.glob_hints_path_atom
 
 ARGUMENT EXTEND hints_path_atom
   PRINTED BY pr_hints_path_atom
-| [ global_list(g) ] -> [ Hints.PathHints (List.map Nametab.global g) ]
-| [ "*" ] -> [ Hints.PathAny ]
+
+  GLOBALIZED BY glob_hints_path_atom
+
+  RAW_PRINTED BY pr_pre_hints_path_atom
+  GLOB_PRINTED BY pr_hints_path_atom
+| [ ne_global_list(g) ] -> [ Hints.PathHints g ]
+| [ "_" ] -> [ Hints.PathAny ]
 END
 
 let pr_hints_path prc prx pry c = Hints.pp_hints_path c
-
+let pr_pre_hints_path prc prx pry c = Hints.pp_hints_path_gen Libnames.pr_reference c
+let glob_hints_path ist = Hints.glob_hints_path
+							      
 ARGUMENT EXTEND hints_path
-  PRINTED BY pr_hints_path
+PRINTED BY pr_hints_path
+
+GLOBALIZED BY glob_hints_path
+RAW_PRINTED BY pr_pre_hints_path
+GLOB_PRINTED BY pr_hints_path
+
 | [ "(" hints_path(p) ")"  ] -> [ p ]
-| [ "!" hints_path(p)  ] -> [ Hints.PathStar p ]
+| [ hints_path(p) "*" ] -> [ Hints.PathStar p ]
 | [ "emp" ] -> [ Hints.PathEmpty ]
 | [ "eps" ] -> [ Hints.PathEpsilon ]
-| [ hints_path_atom(a) ] -> [ Hints.PathAtom a ]
 | [ hints_path(p) "|" hints_path(q) ] -> [ Hints.PathOr (p, q) ]
-| [ hints_path(p) ";" hints_path(q) ] -> [ Hints.PathSeq (p, q) ]
+| [ hints_path_atom(a) ] -> [ Hints.PathAtom a ]
+| [ hints_path(p) hints_path(q) ] -> [ Hints.PathSeq (p, q) ]
 END
 
-let pr_hintbases _prc _prlc _prt = Pptactic.pr_hintbases
-
 ARGUMENT EXTEND opthints
   TYPED AS preident_list_opt
   PRINTED BY pr_hintbases
@@ -203,7 +221,8 @@ END
 
 VERNAC COMMAND EXTEND HintCut CLASSIFIED AS SIDEFF
 | [ "Hint" "Cut" "[" hints_path(p) "]" opthints(dbnames) ] -> [
-  let entry = Hints.HintsCutEntry p in
+  let entry = Hints.HintsCutEntry (Hints.glob_hints_path p) in
     Hints.add_hints (Locality.make_section_locality (Locality.LocalityFixme.consume ()))
       (match dbnames with None -> ["core"] | Some l -> l) entry ]
 END
+
diff --git a/ltac/g_class.ml4 b/ltac/g_class.ml4
index 77075ec4c..a28132a4b 100644
--- a/ltac/g_class.ml4
+++ b/ltac/g_class.ml4
@@ -10,16 +10,12 @@
 
 open Misctypes
 open Class_tactics
-open Pcoq.Tactic
+open Pltac
 open Stdarg
-open Constrarg
+open Tacarg
 
 DECLARE PLUGIN "g_class"
 
-TACTIC EXTEND progress_evars
-  [ "progress_evars" tactic(t) ] -> [ progress_evars (Tacinterp.tactic_of_value ist t) ]
-END
-
 (** Options: depth, debug and transparency settings. *)
 
 let set_transparency cl b =
@@ -48,26 +44,35 @@ ARGUMENT EXTEND debug TYPED AS bool PRINTED BY pr_debug
 | [ ] -> [ false ]
 END
 
-let pr_depth _prc _prlc _prt = function
-    Some i -> Pp.int i
-  | None -> Pp.mt()
+let pr_search_strategy _prc _prlc _prt = function
+  | Some Dfs -> Pp.str "dfs"
+  | Some Bfs -> Pp.str "bfs"
+  | None -> Pp.mt ()
 
-ARGUMENT EXTEND depth TYPED AS int option PRINTED BY pr_depth
-| [ int_or_var_opt(v) ] -> [ match v with Some (ArgArg i) -> Some i | _ -> None ]
+ARGUMENT EXTEND eauto_search_strategy PRINTED BY pr_search_strategy
+| [ "(bfs)" ] -> [ Some Bfs ]
+| [ "(dfs)" ] -> [ Some Dfs ]
+| [ ] -> [ None ] 
 END
 
 (* true = All transparent, false = Opaque if possible *)
 
 VERNAC COMMAND EXTEND Typeclasses_Settings CLASSIFIED AS SIDEFF
- | [ "Typeclasses" "eauto" ":=" debug(d) depth(depth) ] -> [
+ | [ "Typeclasses" "eauto" ":=" debug(d) eauto_search_strategy(s) int_opt(depth) ] -> [
      set_typeclasses_debug d;
+     Option.iter set_typeclasses_strategy s;
      set_typeclasses_depth depth
    ]
 END
 
+(** Compatibility: typeclasses eauto has 8.5 and 8.6 modes *)
 TACTIC EXTEND typeclasses_eauto
-| [ "typeclasses" "eauto" "with" ne_preident_list(l) ] -> [ Proofview.V82.tactic (typeclasses_eauto l) ]
-| [ "typeclasses" "eauto" ] -> [ Proofview.V82.tactic (typeclasses_eauto ~only_classes:true [Hints.typeclasses_db]) ]
+ | [ "typeclasses" "eauto" "bfs" int_or_var_opt(d) "with" ne_preident_list(l) ] ->
+    [ typeclasses_eauto ~strategy:Bfs ~depth:d l ]
+ | [ "typeclasses" "eauto" int_or_var_opt(d) "with" ne_preident_list(l) ] ->
+    [ typeclasses_eauto ~depth:d l ]
+ | [ "typeclasses" "eauto" int_or_var_opt(d) ] -> [
+     typeclasses_eauto ~only_classes:true ~depth:d [Hints.typeclasses_db] ]
 END
 
 TACTIC EXTEND head_of_constr
@@ -85,3 +90,31 @@ END
 TACTIC EXTEND autoapply
   [ "autoapply" constr(c) "using" preident(i) ] -> [ Proofview.V82.tactic (autoapply c i) ]
 END
+
+(** TODO: DEPRECATE *)
+(* A progress test that allows to see if the evars have changed *)
+open Term
+open Proofview.Goal
+open Proofview.Notations
+
+let rec eq_constr_mod_evars x y =
+  match kind_of_term x, kind_of_term y with
+  | Evar (e1, l1), Evar (e2, l2) when not (Evar.equal e1 e2) -> true
+  | _, _ -> compare_constr eq_constr_mod_evars x y
+
+let progress_evars t =
+  Proofview.Goal.nf_enter { enter = begin fun gl ->
+    let concl = Proofview.Goal.concl gl in
+    let check =
+      Proofview.Goal.nf_enter { enter = begin fun gl' ->
+        let newconcl = Proofview.Goal.concl gl' in
+        if eq_constr_mod_evars concl newconcl
+        then Tacticals.New.tclFAIL 0 (Pp.str"No progress made (modulo evars)")
+        else Proofview.tclUNIT ()
+      end }
+    in t <*> check
+  end }
+
+TACTIC EXTEND progress_evars
+  [ "progress_evars" tactic(t) ] -> [ progress_evars (Tacinterp.tactic_of_value ist t) ]
+END
diff --git a/ltac/g_ltac.ml4 b/ltac/g_ltac.ml4
index 308b6415d..54229bb2a 100644
--- a/ltac/g_ltac.ml4
+++ b/ltac/g_ltac.ml4
@@ -19,8 +19,10 @@ open Genredexpr
 open Tok (* necessary for camlp4 *)
 
 open Pcoq
+open Pcoq.Constr
+open Pcoq.Vernac_
 open Pcoq.Prim
-open Pcoq.Tactic
+open Pltac
 
 let fail_default_value = ArgArg 0
 
@@ -30,14 +32,15 @@ let arg_of_expr = function
 
 let genarg_of_unit () = in_gen (rawwit Stdarg.wit_unit) ()
 let genarg_of_int n = in_gen (rawwit Stdarg.wit_int) n
-let genarg_of_ipattern pat = in_gen (rawwit Constrarg.wit_intro_pattern) pat
-let genarg_of_uconstr c = in_gen (rawwit Constrarg.wit_uconstr) c
+let genarg_of_ipattern pat = in_gen (rawwit Stdarg.wit_intro_pattern) pat
+let genarg_of_uconstr c = in_gen (rawwit Stdarg.wit_uconstr) c
+let in_tac tac = in_gen (rawwit Tacarg.wit_ltac) tac
 
 let reference_to_id = function
   | Libnames.Ident (loc, id) -> (loc, id)
   | Libnames.Qualid (loc,_) ->
-      Errors.user_err_loc (loc, "",
-        str "This expression should be a simple identifier.")
+      CErrors.user_err ~loc 
+       (str "This expression should be a simple identifier.")
 
 let tactic_mode = Gram.entry_create "vernac:tactic_command"
 
@@ -45,7 +48,7 @@ let new_entry name =
   let e = Gram.entry_create name in
   e
 
-let selector = new_entry "vernac:selector"
+let toplevel_selector = new_entry "vernac:toplevel_selector"
 let tacdef_body = new_entry "tactic:tacdef_body"
 
 (* Registers the Classic Proof Mode (which uses [tactic_mode] as a parser for
@@ -71,9 +74,17 @@ let test_bracket_ident =
 
 (* Tactics grammar rules *)
 
+let hint = G_proofs.hint
+
+let warn_deprecated_appcontext =
+  CWarnings.create ~name:"deprecated-appcontext" ~category:"deprecated"
+         (fun () -> strbrk "appcontext is deprecated and will be removed " ++
+                      strbrk "in a future version")
+
 GEXTEND Gram
-  GLOBAL: tactic tacdef_body tactic_expr binder_tactic tactic_arg
-          tactic_mode constr_may_eval constr_eval selector;
+  GLOBAL: tactic tacdef_body tactic_expr binder_tactic tactic_arg command hint
+          tactic_mode constr_may_eval constr_eval toplevel_selector
+          operconstr;
 
   tactic_then_last:
     [ [ "|"; lta = LIST0 OPT tactic_expr SEP "|" ->
@@ -119,7 +130,8 @@ GEXTEND Gram
 (*To do: put Abstract in Refiner*)
       | IDENT "abstract"; tc = NEXT -> TacAbstract (tc,None)
       | IDENT "abstract"; tc = NEXT; "using";  s = ident ->
-          TacAbstract (tc,Some s) ]
+          TacAbstract (tc,Some s)
+      | sel = selector; ta = tactic_expr -> TacSelect (sel, ta) ]
 (*End of To do*)
     | "2" RIGHTA
       [ ta0 = tactic_expr; "+"; ta1 = binder_tactic -> TacOr (ta0,ta1)
@@ -173,9 +185,8 @@ GEXTEND Gram
   (* Tactic arguments to the right of an application *)
   tactic_arg_compat:
     [ [ a = tactic_arg -> a
-      | r = reference -> Reference r
-      | c = Constr.constr -> ConstrMayEval (ConstrTerm c)
-      (* Unambigous entries: tolerated w/o "ltac:" modifier *)
+      | c = Constr.constr -> (match c with CRef (r,None) -> Reference r | c -> ConstrMayEval (ConstrTerm c))
+      (* Unambiguous entries: tolerated w/o "ltac:" modifier *)
       | "()" -> TacGeneric (genarg_of_unit ()) ] ]
   ;
   (* Can be used as argument and at toplevel in tactic expressions. *)
@@ -231,7 +242,7 @@ GEXTEND Gram
         Subterm (mode, oid, pc)
       | IDENT "appcontext";  oid = OPT Constr.ident;
           "["; pc = Constr.lconstr_pattern; "]" ->
-        Feedback.msg_warning (strbrk "appcontext is deprecated");
+        warn_deprecated_appcontext ~loc:!@loc ();
         Subterm (true,oid, pc)
       | pc = Constr.lconstr_pattern -> Term pc ] ]
   ;
@@ -281,31 +292,71 @@ GEXTEND Gram
   (* Definitions for tactics *)
   tacdef_body:
     [ [ name = Constr.global; it=LIST1 input_fun; redef = ltac_def_kind; body = tactic_expr ->
-          if redef then Vernacexpr.TacticRedefinition (name, TacFun (it, body))
+          if redef then Tacexpr.TacticRedefinition (name, TacFun (it, body))
           else
             let id = reference_to_id name in
-            Vernacexpr.TacticDefinition (id, TacFun (it, body))
+            Tacexpr.TacticDefinition (id, TacFun (it, body))
       | name = Constr.global; redef = ltac_def_kind; body = tactic_expr ->
-          if redef then Vernacexpr.TacticRedefinition (name, body)
+          if redef then Tacexpr.TacticRedefinition (name, body)
           else
             let id = reference_to_id name in
-            Vernacexpr.TacticDefinition (id, body)
+            Tacexpr.TacticDefinition (id, body)
     ] ]
   ;
   tactic:
     [ [ tac = tactic_expr -> tac ] ]
   ;
+
+  range_selector:
+    [ [ n = natural ; "-" ; m = natural -> (n, m)
+      | n = natural -> (n, n) ] ]
+  ;
+  (* We unfold a range selectors list once so that we can make a special case
+   * for a unique SelectNth selector. *)
+  range_selector_or_nth:
+    [ [ n = natural ; "-" ; m = natural;
+        l = OPT [","; l = LIST1 range_selector SEP "," -> l] ->
+          SelectList ((n, m) :: Option.default [] l)
+      | n = natural;
+        l = OPT [","; l = LIST1 range_selector SEP "," -> l] ->
+          Option.cata (fun l -> SelectList ((n, n) :: l)) (SelectNth n) l ] ]
+  ;
+  selector_body:
+  [ [ l = range_selector_or_nth -> l
+    | test_bracket_ident; "["; id = ident; "]" -> SelectId id ] ]
+  ;
   selector:
-    [ [ n=natural; ":" -> Vernacexpr.SelectNth n
-      | test_bracket_ident; "["; id = ident; "]"; ":" -> Vernacexpr.SelectId id
-      | IDENT "all" ; ":" -> Vernacexpr.SelectAll ] ]
+    [ [ IDENT "only"; sel = selector_body; ":" -> sel ] ]
+  ;
+  toplevel_selector:
+    [ [ sel = selector_body; ":" -> sel
+    |   IDENT "all"; ":" -> SelectAll ] ]
   ;
   tactic_mode:
-    [ [ g = OPT selector; tac = G_vernac.subgoal_command -> tac g ] ]
+    [ [ g = OPT toplevel_selector; tac = G_vernac.subgoal_command -> tac g ] ]
+  ;
+  command:
+    [ [ IDENT "Proof"; "with"; ta = Pltac.tactic; 
+        l = OPT [ "using"; l = G_vernac.section_subset_expr -> l ] ->
+          Vernacexpr.VernacProof (Some (in_tac ta), G_proofs.hint_proof_using G_vernac.section_subset_expr l)
+      | IDENT "Proof"; "using"; l = G_vernac.section_subset_expr;
+        ta = OPT [ "with"; ta = Pltac.tactic -> in_tac ta ] ->
+          Vernacexpr.VernacProof (ta,Some l) ] ]
+  ;
+  hint:
+    [ [ IDENT "Extern"; n = natural; c = OPT Constr.constr_pattern ; "=>";
+        tac = Pltac.tactic ->
+          Vernacexpr.HintsExtern (n,c, in_tac tac) ] ]
+  ;
+  operconstr: LEVEL "0"
+    [ [ IDENT "ltac"; ":"; "("; tac = Pltac.tactic_expr; ")" ->
+          let arg = Genarg.in_gen (Genarg.rawwit Tacarg.wit_tactic) tac in
+          CHole (!@loc, None, IntroAnonymous, Some arg) ] ]
   ;
   END
 
-open Constrarg
+open Stdarg
+open Tacarg
 open Vernacexpr
 open Vernac_classifier
 open Goptions
@@ -325,7 +376,7 @@ let _ = declare_int_option {
 let vernac_solve n info tcom b =
   let status = Proof_global.with_current_proof (fun etac p ->
     let with_end_tac = if b then Some etac else None in
-    let global = match n with SelectAll -> true | _ -> false in
+    let global = match n with SelectAll | SelectList _ -> true | _ -> false in
     let info = Option.append info !print_info_trace in
     let (p,status) =
       Pfedit.solve n info (Tacinterp.hide_interp global tcom None) ?with_end_tac p
@@ -336,13 +387,19 @@ let vernac_solve n info tcom b =
     p,status) in
     if not status then Feedback.feedback Feedback.AddedAxiom
 
+let pr_range_selector (i, j) =
+  if Int.equal i j then int i
+  else int i ++ str "-" ++ int j
+
 let pr_ltac_selector = function
 | SelectNth i -> int i ++ str ":"
+| SelectList l -> str "[" ++ prlist_with_sep (fun () -> str ", ") pr_range_selector l ++
+    str "]" ++ str ":"
 | SelectId id -> str "[" ++ Nameops.pr_id id ++ str "]" ++ str ":"
 | SelectAll -> str "all" ++ str ":"
 
 VERNAC ARGUMENT EXTEND ltac_selector PRINTED BY pr_ltac_selector
-| [ selector(s) ] -> [ s ]
+| [ toplevel_selector(s) ] -> [ s ]
 END
 
 let pr_ltac_info n = str "Info" ++ spc () ++ int n
@@ -359,6 +416,16 @@ VERNAC ARGUMENT EXTEND ltac_use_default PRINTED BY pr_ltac_use_default
 | [ "..." ] -> [ true ]
 END
 
+let is_anonymous_abstract = function
+  | TacAbstract (_,None) -> true
+  | TacSolve [TacAbstract (_,None)] -> true
+  | _ -> false
+let rm_abstract = function
+  | TacAbstract (t,_) -> t
+  | TacSolve [TacAbstract (t,_)] -> TacSolve [t]
+  | x -> x
+let is_explicit_terminator = function TacSolve _ -> true | _ -> false
+
 VERNAC tactic_mode EXTEND VernacSolve
 | [ - ltac_selector_opt(g) ltac_info_opt(n) tactic(t) ltac_use_default(def) ] =>
     [ classify_as_proofstep ] -> [
@@ -366,9 +433,17 @@ VERNAC tactic_mode EXTEND VernacSolve
     vernac_solve g n t def
   ]
 | [ - "par" ":" ltac_info_opt(n) tactic(t) ltac_use_default(def) ] =>
-    [ VtProofStep true, VtLater ] -> [
-    vernac_solve SelectAll n t def
-  ]
+    [
+      let anon_abstracting_tac = is_anonymous_abstract t in
+      let solving_tac = is_explicit_terminator t in
+      let parallel = `Yes (solving_tac,anon_abstracting_tac) in
+      let pbr = if solving_tac then Some "par" else None in
+      VtProofStep{ parallel = parallel; proof_block_detection = pbr },
+      VtLater
+    ] -> [
+      let t = rm_abstract t in
+      vernac_solve SelectAll n t def
+    ]
 END
 
 let pr_ltac_tactic_level n = str "(at level " ++ int n ++ str ")"
@@ -445,3 +520,7 @@ VERNAC COMMAND EXTEND VernacDeclareTacticDefinition
     Tacentries.register_ltac (Locality.make_module_locality lc) l
   ]
 END
+
+VERNAC COMMAND EXTEND VernacPrintLtacs CLASSIFIED AS QUERY
+| [ "Print" "Ltac" "Signatures" ] -> [ Tacentries.print_ltacs () ]
+END
diff --git a/ltac/g_obligations.ml4 b/ltac/g_obligations.ml4
index 987b9d538..d286a5870 100644
--- a/ltac/g_obligations.ml4
+++ b/ltac/g_obligations.ml4
@@ -17,7 +17,7 @@ open Libnames
 open Constrexpr
 open Constrexpr_ops
 open Stdarg
-open Constrarg
+open Tacarg
 open Extraargs
 
 let (set_default_tactic, get_default_tactic, print_default_tactic) = 
@@ -30,12 +30,23 @@ let () =
   end in
   Obligations.default_tactic := tac
 
+let with_tac f tac =
+  let env = { Genintern.genv = Global.env (); ltacvars = Names.Id.Set.empty } in
+  let tac = match tac with
+  | None -> None
+  | Some tac ->
+    let tac = Genarg.in_gen (Genarg.rawwit wit_ltac) tac in
+    let _, tac = Genintern.generic_intern env tac in
+    Some tac
+  in
+  f tac
+
 (* We define new entries for programs, with the use of this module
  * Subtac. These entries are named Subtac.<foo>
  *)
 
 module Gram = Pcoq.Gram
-module Tactic = Pcoq.Tactic
+module Tactic = Pltac
 
 open Pcoq
 
@@ -66,6 +77,9 @@ GEXTEND Gram
 
 open Obligations
 
+let obligation obl tac = with_tac (fun t -> Obligations.obligation obl t) tac
+let next_obligation obl tac = with_tac (fun t -> Obligations.next_obligation obl t) tac
+
 let classify_obbl _ = Vernacexpr.(VtStartProof ("Classic",Doesn'tGuaranteeOpacity,[]), VtLater)
 
 VERNAC COMMAND EXTEND Obligations CLASSIFIED BY classify_obbl
diff --git a/ltac/g_rewrite.ml4 b/ltac/g_rewrite.ml4
index 29ffbed19..b1c4f58eb 100644
--- a/ltac/g_rewrite.ml4
+++ b/ltac/g_rewrite.ml4
@@ -21,10 +21,10 @@ open Tacmach
 open Tacticals
 open Rewrite
 open Stdarg
-open Constrarg
+open Pcoq.Vernac_
 open Pcoq.Prim
 open Pcoq.Constr
-open Pcoq.Tactic
+open Pltac
 
 DECLARE PLUGIN "g_rewrite"
 
@@ -63,8 +63,17 @@ let glob_strategy ist s = map_strategy (Tacintern.intern_constr ist) (fun c -> c
 let subst_strategy s str = str
 
 let pr_strategy _ _ _ (s : strategy) = Pp.str "<strategy>"
-let pr_raw_strategy _ _ _ (s : raw_strategy) = Pp.str "<strategy>"
-let pr_glob_strategy _ _ _ (s : glob_strategy) = Pp.str "<strategy>"
+let pr_raw_strategy prc prlc _ (s : raw_strategy) =
+  let prr = Pptactic.pr_red_expr (prc, prlc, Pputils.pr_or_by_notation Libnames.pr_reference, prc) in
+  Rewrite.pr_strategy prc prr s
+let pr_glob_strategy prc prlc _ (s : glob_strategy) =
+  let prr = Pptactic.pr_red_expr
+    (Ppconstr.pr_constr_expr,
+    Ppconstr.pr_lconstr_expr,
+    Pputils.pr_or_by_notation Libnames.pr_reference,
+    Ppconstr.pr_constr_expr)
+  in
+  Rewrite.pr_strategy prc prr s
 
 ARGUMENT EXTEND rewstrategy
     PRINTED BY pr_strategy
@@ -106,17 +115,11 @@ END
 let db_strat db = StratUnary (Topdown, StratHints (false, db))
 let cl_rewrite_clause_db db = cl_rewrite_clause_strat (strategy_of_ast (db_strat db))
 
-let cl_rewrite_clause_db = 
-  if Flags.profile then
-    let key = Profile.declare_profile "cl_rewrite_clause_db" in
-      Profile.profile3 key cl_rewrite_clause_db
-  else cl_rewrite_clause_db
-
 TACTIC EXTEND rewrite_strat
-| [ "rewrite_strat" rewstrategy(s) "in" hyp(id) ] -> [ Proofview.V82.tactic (cl_rewrite_clause_strat s (Some id)) ]
-| [ "rewrite_strat" rewstrategy(s) ] -> [ Proofview.V82.tactic (cl_rewrite_clause_strat s None) ]
-| [ "rewrite_db" preident(db) "in" hyp(id) ] -> [ Proofview.V82.tactic (cl_rewrite_clause_db db (Some id)) ]
-| [ "rewrite_db" preident(db) ] -> [ Proofview.V82.tactic (cl_rewrite_clause_db db None) ]
+| [ "rewrite_strat" rewstrategy(s) "in" hyp(id) ] -> [ cl_rewrite_clause_strat s (Some id) ]
+| [ "rewrite_strat" rewstrategy(s) ] -> [ cl_rewrite_clause_strat s None ]
+| [ "rewrite_db" preident(db) "in" hyp(id) ] -> [ cl_rewrite_clause_db db (Some id) ]
+| [ "rewrite_db" preident(db) ] -> [ cl_rewrite_clause_db db None ]
 END
 
 let clsubstitute o c =
@@ -125,7 +128,7 @@ let clsubstitute o c =
       (fun cl ->
         match cl with
           | Some id when is_tac id -> tclIDTAC
-          | _ -> cl_rewrite_clause c o AllOccurrences cl)
+          | _ -> Proofview.V82.of_tactic (cl_rewrite_clause c o AllOccurrences cl))
 
 TACTIC EXTEND substitute
 | [ "substitute" orient(o) glob_constr_with_bindings(c) ] -> [ Proofview.V82.tactic (clsubstitute o c) ]
@@ -136,15 +139,15 @@ END
 
 TACTIC EXTEND setoid_rewrite
    [ "setoid_rewrite" orient(o) glob_constr_with_bindings(c) ]
-   -> [ Proofview.V82.tactic (cl_rewrite_clause c o AllOccurrences None) ]
+   -> [ cl_rewrite_clause c o AllOccurrences None ]
  | [ "setoid_rewrite" orient(o) glob_constr_with_bindings(c) "in" hyp(id) ] ->
-      [ Proofview.V82.tactic (cl_rewrite_clause c o AllOccurrences (Some id))]
+      [ cl_rewrite_clause c o AllOccurrences (Some id) ]
  | [ "setoid_rewrite" orient(o) glob_constr_with_bindings(c) "at" occurrences(occ) ] ->
-      [ Proofview.V82.tactic (cl_rewrite_clause c o (occurrences_of occ) None)]
+      [ cl_rewrite_clause c o (occurrences_of occ) None ]
  | [ "setoid_rewrite" orient(o) glob_constr_with_bindings(c) "at" occurrences(occ) "in" hyp(id)] ->
-      [ Proofview.V82.tactic (cl_rewrite_clause c o (occurrences_of occ) (Some id))]
+      [ cl_rewrite_clause c o (occurrences_of occ) (Some id) ]
  | [ "setoid_rewrite" orient(o) glob_constr_with_bindings(c) "in" hyp(id) "at" occurrences(occ)] ->
-      [ Proofview.V82.tactic (cl_rewrite_clause c o (occurrences_of occ) (Some id))]
+      [ cl_rewrite_clause c o (occurrences_of occ) (Some id) ]
 END
 
 VERNAC COMMAND EXTEND AddRelation CLASSIFIED AS SIDEFF
@@ -187,6 +190,11 @@ let wit_binders =
 
 let binders = Pcoq.create_generic_entry Pcoq.utactic "binders" (Genarg.rawwit wit_binders)
 
+let () =
+  let raw_printer _ _ _ l = Pp.pr_non_empty_arg Ppconstr.pr_binders l in
+  let printer _ _ _ _ = Pp.str "<Unavailable printer for binders>" in
+  Pptactic.declare_extra_genarg_pprule wit_binders raw_printer printer printer
+
 open Pcoq
 
 GEXTEND Gram
diff --git a/parsing/g_tactic.ml4 b/ltac/g_tactic.ml4
index cfe5377d6..685c07c9a 100644
--- a/parsing/g_tactic.ml4
+++ b/ltac/g_tactic.ml4
@@ -7,7 +7,7 @@
 (************************************************************************)
 
 open Pp
-open Errors
+open CErrors
 open Util
 open Tacexpr
 open Genredexpr
@@ -22,7 +22,7 @@ open Decl_kinds
 open Pcoq
 
 
-let all_with delta = Redops.make_red_flag [FBeta;FIota;FZeta;delta]
+let all_with delta = Redops.make_red_flag [FBeta;FMatch;FFix;FCofix;FZeta;delta]
 
 let tactic_kw = [ "->"; "<-" ; "by" ]
 let _ = List.iter CLexer.add_keyword tactic_kw
@@ -111,8 +111,8 @@ let check_for_coloneq =
       | KEYWORD "(" -> skip_binders 2
       | _ -> err ())
 
-let lookup_at_as_coma =
-  Gram.Entry.of_parser "lookup_at_as_coma"
+let lookup_at_as_comma =
+  Gram.Entry.of_parser "lookup_at_as_comma"
     (fun strm ->
       match get_tok (stream_nth 0 strm) with
 	| KEYWORD (","|"at"|"as") -> ()
@@ -120,7 +120,7 @@ let lookup_at_as_coma =
 
 open Constr
 open Prim
-open Tactic
+open Pltac
 
 let mk_fix_tac (loc,id,bl,ann,ty) =
   let n =
@@ -135,17 +135,17 @@ let mk_fix_tac (loc,id,bl,ann,ty) =
 
 let mk_cofix_tac (loc,id,bl,ann,ty) =
   let _ = Option.map (fun (aloc,_) ->
-    user_err_loc
-      (aloc,"Constr:mk_cofix_tac",
-       Pp.str"Annotation forbidden in cofix expression.")) ann in
+    user_err ~loc:aloc
+      ~hdr:"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,lbind as clbind) = match lbind with
+let destruction_arg_of_constr (c,lbind as clbind) = match lbind with
   | NoBindings ->
     begin
       try ElimOnIdent (Constrexpr_ops.constr_loc c,snd(Constrexpr_ops.coerce_to_id c))
-      with e when Errors.noncritical e -> ElimOnConstr clbind
+      with e when CErrors.noncritical e -> ElimOnConstr clbind
     end
   | _ -> ElimOnConstr clbind
 
@@ -192,7 +192,7 @@ let merge_occurrences loc cl = function
   | None ->
       if Locusops.clause_with_generic_occurrences cl then (None, cl)
       else
-	user_err_loc (loc,"",str "Found an \"at\" clause without \"with\" clause.")
+	user_err ~loc  (str "Found an \"at\" clause without \"with\" clause.")
   | Some (occs, p) ->
     let ans = match occs with
     | AllOccurrences -> cl
@@ -204,19 +204,25 @@ let merge_occurrences loc cl = function
         { cl with onhyps = Some [(occs, id), l] }
       | _ ->
         if Locusops.clause_with_generic_occurrences cl then
-          user_err_loc (loc,"",str "Unable to interpret the \"at\" clause; move it in the \"in\" clause.")
+          user_err ~loc  (str "Unable to interpret the \"at\" clause; move it in the \"in\" clause.")
         else
-          user_err_loc (loc,"",str "Cannot use clause \"at\" twice.")
+          user_err ~loc  (str "Cannot use clause \"at\" twice.")
       end
     in
     (Some p, ans)
 
+let warn_deprecated_eqn_syntax =
+  CWarnings.create ~name:"deprecated-eqn-syntax" ~category:"deprecated"
+         (fun arg -> strbrk (Printf.sprintf "Syntax \"_eqn:%s\" is deprecated. Please use \"eqn:%s\" instead." arg arg))
+
 (* Auxiliary grammar rules *)
 
+open Vernac_
+
 GEXTEND Gram
   GLOBAL: simple_tactic constr_with_bindings quantified_hypothesis
   bindings red_expr int_or_var open_constr uconstr
-  simple_intropattern clause_dft_concl hypident;
+  simple_intropattern in_clause clause_dft_concl hypident destruction_arg;
 
   int_or_var:
     [ [ n = integer  -> ArgArg n
@@ -236,11 +242,11 @@ GEXTEND Gram
   uconstr:
     [ [ c = constr -> c ] ]
   ;
-  induction_arg:
+  destruction_arg:
     [ [ n = natural -> (None,ElimOnAnonHyp n)
       | test_lpar_id_rpar; c = constr_with_bindings ->
-        (Some false,induction_arg_of_constr c)
-      | c = constr_with_bindings_arg -> on_snd induction_arg_of_constr c
+        (Some false,destruction_arg_of_constr c)
+      | c = constr_with_bindings_arg -> on_snd destruction_arg_of_constr c
     ] ]
   ;
   constr_with_bindings_arg:
@@ -344,11 +350,14 @@ GEXTEND Gram
   with_bindings:
     [ [ "with"; bl = bindings -> bl | -> NoBindings ] ]
   ;
-  red_flag:
-    [ [ IDENT "beta" -> FBeta
-      | IDENT "iota" -> FIota
-      | IDENT "zeta" -> FZeta
-      | IDENT "delta"; d = delta_flag -> d
+  red_flags:
+    [ [ IDENT "beta" -> [FBeta]
+      | IDENT "iota" -> [FMatch;FFix;FCofix]
+      | IDENT "match" -> [FMatch]
+      | IDENT "fix" -> [FFix]
+      | IDENT "cofix" -> [FCofix]
+      | IDENT "zeta" -> [FZeta]
+      | IDENT "delta"; d = delta_flag -> [d]
     ] ]
   ;
   delta_flag:
@@ -358,7 +367,7 @@ GEXTEND Gram
     ] ]
   ;
   strategy_flag:
-    [ [ s = LIST1 red_flag -> Redops.make_red_flag s
+    [ [ s = LIST1 red_flags -> Redops.make_red_flag (List.flatten s)
       | d = delta_flag -> all_with d
     ] ]
   ;
@@ -469,27 +478,20 @@ GEXTEND Gram
   eqn_ipat:
     [ [ IDENT "eqn"; ":"; pat = naming_intropattern -> Some (!@loc, pat)
       | IDENT "_eqn"; ":"; pat = naming_intropattern ->
-        let msg = "Obsolete syntax \"_eqn:H\" could be replaced by \"eqn:H\"" in
-        Feedback.msg_warning (strbrk msg); Some (!@loc, pat)
+         let loc = !@loc in
+	 warn_deprecated_eqn_syntax ~loc "H"; Some (loc, pat)
       | IDENT "_eqn" ->
-        let msg = "Obsolete syntax \"_eqn\" could be replaced by \"eqn:?\"" in
-        Feedback.msg_warning (strbrk msg); Some (!@loc, IntroAnonymous)
+         let loc = !@loc in
+	 warn_deprecated_eqn_syntax ~loc "?"; Some (loc, IntroAnonymous)
       | -> None ] ]
   ;
   as_name:
     [ [ "as"; id = ident -> Names.Name id | -> Names.Anonymous ] ]
   ;
   by_tactic:
-    [ [ "by"; tac = tactic_expr LEVEL "3" -> TacComplete tac
-      | -> TacId [] ] ]
-  ;
-  opt_by_tactic:
     [ [ "by"; tac = tactic_expr LEVEL "3" -> Some tac
     | -> None ] ]
   ;
-  rename :
-    [ [ id1 = id_or_meta; IDENT "into"; id2 = id_or_meta -> (id1,id2) ] ]
-  ;
   rewriter :
     [ [ "!"; c = constr_with_bindings_arg -> (RepeatPlus,c)
       | ["?"| LEFTQMARK]; c = constr_with_bindings_arg -> (RepeatStar,c)
@@ -503,8 +505,8 @@ GEXTEND Gram
     [ [ b = orient; p = rewriter -> let (m,c) = p in (b,m,c) ] ]
   ;
   induction_clause:
-    [ [ c = induction_arg; pat = as_or_and_ipat; eq = eqn_ipat; cl = opt_clause
-        -> (c,(eq,pat),cl) ] ]
+    [ [ c = destruction_arg; pat = as_or_and_ipat; eq = eqn_ipat;
+        cl = opt_clause -> (c,(eq,pat),cl) ] ]
   ;
   induction_clause_list:
     [ [ ic = LIST1 induction_clause SEP ","; el = OPT eliminator;
@@ -515,26 +517,15 @@ GEXTEND Gram
         | _,_,Some _ -> err ()
         | _,_,None -> (ic,el) ]]
   ;
-  move_location:
-    [ [ IDENT "after"; id = id_or_meta -> MoveAfter id
-      | IDENT "before"; id = id_or_meta -> MoveBefore id
-      | "at"; IDENT "top" -> MoveFirst
-      | "at"; IDENT "bottom" -> MoveLast ] ]
-  ;
   simple_tactic:
     [ [
       (* Basic tactics *)
         IDENT "intros"; pl = ne_intropatterns ->
-          TacAtom (!@loc, TacIntroPattern pl)
+          TacAtom (!@loc, TacIntroPattern (false,pl))
       | IDENT "intros" ->
-          TacAtom (!@loc, TacIntroPattern [!@loc,IntroForthcoming false])
-      | IDENT "intro"; id = ident; hto = move_location ->
-	  TacAtom (!@loc, TacIntroMove (Some id, hto))
-      | IDENT "intro"; hto = move_location -> TacAtom (!@loc, TacIntroMove (None, hto))
-      | IDENT "intro"; id = ident -> TacAtom (!@loc, TacIntroMove (Some id, MoveLast))
-      | IDENT "intro" -> TacAtom (!@loc, TacIntroMove (None, MoveLast))
-
-      | IDENT "exact"; c = constr -> TacAtom (!@loc, TacExact c)
+          TacAtom (!@loc, TacIntroPattern (false,[!@loc,IntroForthcoming false]))
+      | IDENT "eintros"; pl = ne_intropatterns ->
+          TacAtom (!@loc, TacIntroPattern (true,pl))
 
       | IDENT "apply"; cl = LIST1 constr_with_bindings_arg SEP ",";
           inhyp = in_hyp_as -> TacAtom (!@loc, TacApply (true,false,cl,inhyp))
@@ -596,7 +587,7 @@ GEXTEND Gram
       | IDENT "generalize"; c = constr; l = LIST1 constr ->
 	  let gen_everywhere c = ((AllOccurrences,c),Names.Anonymous) in
           TacAtom (!@loc, TacGeneralize (List.map gen_everywhere (c::l)))
-      | IDENT "generalize"; c = constr; lookup_at_as_coma; nl = occs;
+      | IDENT "generalize"; c = constr; lookup_at_as_comma; nl = occs;
           na = as_name;
           l = LIST0 [","; c = pattern_occ; na = as_name -> (c,na)] ->
           TacAtom (!@loc, TacGeneralize (((nl,c),na)::l))
@@ -606,21 +597,16 @@ GEXTEND Gram
 	  TacAtom (!@loc, TacInductionDestruct (true,false,ic))
       | IDENT "einduction"; ic = induction_clause_list ->
 	  TacAtom (!@loc, TacInductionDestruct(true,true,ic))
-      | IDENT "double"; IDENT "induction"; h1 = quantified_hypothesis;
-	  h2 = quantified_hypothesis -> TacAtom (!@loc, TacDoubleInduction (h1,h2))
       | IDENT "destruct"; icl = induction_clause_list ->
 	  TacAtom (!@loc, TacInductionDestruct(false,false,icl))
       | IDENT "edestruct";  icl = induction_clause_list ->
 	  TacAtom (!@loc, TacInductionDestruct(false,true,icl))
 
-      (* Context management *)
-      | IDENT "rename"; l = LIST1 rename SEP "," -> TacAtom (!@loc, TacRename l)
-
       (* Equality and inversion *)
       | IDENT "rewrite"; l = LIST1 oriented_rewriter SEP ",";
-	  cl = clause_dft_concl; t=opt_by_tactic -> TacAtom (!@loc, TacRewrite (false,l,cl,t))
+	  cl = clause_dft_concl; t=by_tactic -> TacAtom (!@loc, TacRewrite (false,l,cl,t))
       | IDENT "erewrite"; l = LIST1 oriented_rewriter SEP ",";
-	  cl = clause_dft_concl; t=opt_by_tactic -> TacAtom (!@loc, TacRewrite (true,l,cl,t))
+	  cl = clause_dft_concl; t=by_tactic -> TacAtom (!@loc, TacRewrite (true,l,cl,t))
       | IDENT "dependent"; k =
 	  [ IDENT "simple"; IDENT "inversion" -> SimpleInversion
 	  | IDENT "inversion" -> FullInversion
diff --git a/ltac/ltac.mllib b/ltac/ltac.mllib
index e0c6f3ac0..af1c7149d 100644
--- a/ltac/ltac.mllib
+++ b/ltac/ltac.mllib
@@ -1,8 +1,14 @@
+Tacarg
+Pptactic
+Pltac
+Taccoerce
 Tacsubst
 Tacenv
 Tactic_debug
 Tacintern
 Tacentries
+Profile_ltac
+Tactic_matching
 Tacinterp
 Evar_tactics
 Tactic_option
@@ -10,10 +16,12 @@ Extraargs
 G_obligations
 Coretactics
 Extratactics
+Profile_ltac_tactics
 G_auto
 G_class
 Rewrite
 G_rewrite
 Tauto
 G_eqdecide
+G_tactic
 G_ltac
diff --git a/ltac/pltac.ml b/ltac/pltac.ml
new file mode 100644
index 000000000..1d21118ae
--- /dev/null
+++ b/ltac/pltac.ml
@@ -0,0 +1,65 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+open Names
+open Pcoq
+
+(* Main entry for extensions *)
+let simple_tactic = Gram.entry_create "tactic:simple_tactic"
+
+let make_gen_entry _ name = Gram.entry_create ("tactic:" ^ name)
+
+(* Entries that can be referred via the string -> Gram.entry table *)
+(* Typically for tactic user extensions *)
+let open_constr =
+  make_gen_entry utactic "open_constr"
+let constr_with_bindings =
+  make_gen_entry utactic "constr_with_bindings"
+let bindings =
+  make_gen_entry utactic "bindings"
+let hypident = Gram.entry_create "hypident"
+let constr_may_eval = make_gen_entry utactic "constr_may_eval"
+let constr_eval = make_gen_entry utactic "constr_eval"
+let uconstr =
+  make_gen_entry utactic "uconstr"
+let quantified_hypothesis =
+  make_gen_entry utactic "quantified_hypothesis"
+let destruction_arg = make_gen_entry utactic "destruction_arg"
+let int_or_var = make_gen_entry utactic "int_or_var"
+let simple_intropattern =
+  make_gen_entry utactic "simple_intropattern"
+let in_clause = make_gen_entry utactic "in_clause"
+let clause_dft_concl = 
+  make_gen_entry utactic "clause"
+
+
+(* Main entries for ltac *)
+let tactic_arg = Gram.entry_create "tactic:tactic_arg"
+let tactic_expr = make_gen_entry utactic "tactic_expr"
+let binder_tactic = make_gen_entry utactic "binder_tactic"
+
+let tactic = make_gen_entry utactic "tactic"
+
+(* Main entry for quotations *)
+let tactic_eoi = eoi_entry tactic
+
+let () =
+  let open Stdarg in
+  let open Tacarg in
+  register_grammar wit_int_or_var (int_or_var);
+  register_grammar wit_intro_pattern (simple_intropattern);
+  register_grammar wit_quant_hyp (quantified_hypothesis);
+  register_grammar wit_uconstr (uconstr);
+  register_grammar wit_open_constr (open_constr);
+  register_grammar wit_constr_with_bindings (constr_with_bindings);
+  register_grammar wit_bindings (bindings);
+  register_grammar wit_tactic (tactic);
+  register_grammar wit_ltac (tactic);
+  register_grammar wit_clause_dft_concl (clause_dft_concl);
+  register_grammar wit_destruction_arg (destruction_arg);
+  ()
diff --git a/ltac/pltac.mli b/ltac/pltac.mli
new file mode 100644
index 000000000..810e1ec39
--- /dev/null
+++ b/ltac/pltac.mli
@@ -0,0 +1,38 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+(** Ltac parsing entries *)
+
+open Loc
+open Names
+open Pcoq
+open Libnames
+open Constrexpr
+open Tacexpr
+open Genredexpr
+open Misctypes
+
+val open_constr : constr_expr Gram.entry
+val constr_with_bindings : constr_expr with_bindings Gram.entry
+val bindings : constr_expr bindings Gram.entry
+val hypident : (Id.t located * Locus.hyp_location_flag) Gram.entry
+val constr_may_eval : (constr_expr,reference or_by_notation,constr_expr) may_eval Gram.entry
+val constr_eval : (constr_expr,reference or_by_notation,constr_expr) may_eval Gram.entry
+val uconstr : constr_expr Gram.entry
+val quantified_hypothesis : quantified_hypothesis Gram.entry
+val destruction_arg : constr_expr with_bindings destruction_arg Gram.entry
+val int_or_var : int or_var Gram.entry
+val simple_tactic : raw_tactic_expr Gram.entry
+val simple_intropattern : constr_expr intro_pattern_expr located Gram.entry
+val in_clause : Names.Id.t Loc.located Locus.clause_expr Gram.entry
+val clause_dft_concl : Names.Id.t Loc.located Locus.clause_expr Gram.entry
+val tactic_arg : raw_tactic_arg Gram.entry
+val tactic_expr : raw_tactic_expr Gram.entry
+val binder_tactic : raw_tactic_expr Gram.entry
+val tactic : raw_tactic_expr Gram.entry
+val tactic_eoi : raw_tactic_expr Gram.entry
diff --git a/printing/pptactic.ml b/ltac/pptactic.ml
index 44c832bd7..fccee6e40 100644
--- a/printing/pptactic.ml
+++ b/ltac/pptactic.ml
@@ -9,19 +9,21 @@
 open Pp
 open Names
 open Namegen
-open Errors
+open CErrors
 open Util
 open Constrexpr
 open Tacexpr
 open Genarg
 open Geninterp
-open Constrarg
+open Stdarg
+open Tacarg
 open Libnames
 open Ppextend
 open Misctypes
 open Locus
 open Decl_kinds
 open Genredexpr
+open Pputils
 open Ppconstr
 open Printer
 
@@ -62,19 +64,6 @@ type 'a extra_genarg_printer =
     (tolerability -> Val.t -> std_ppcmds) ->
     'a -> std_ppcmds
 
-let genarg_pprule = ref String.Map.empty
-
-let declare_extra_genarg_pprule wit f g h =
-  let s = match wit with
-    | ExtraArg s -> ArgT.repr s
-    | _ -> error
-      "Can declare a pretty-printing rule only for extra argument types."
-  in
-  let f prc prlc prtac x = f prc prlc prtac (out_gen (rawwit wit) x) in
-  let g prc prlc prtac x = g prc prlc prtac (out_gen (glbwit wit) x) in
-  let h prc prlc prtac x = h prc prlc prtac (out_gen (topwit wit) x) in
-  genarg_pprule := String.Map.add s (f,g,h) !genarg_pprule
-
 module Make
   (Ppconstr : Ppconstrsig.Pp)
   (Taggers : sig
@@ -135,75 +124,8 @@ module Make
           end
         | _ -> default
 
-  let pr_with_occurrences pr (occs,c) =
-    match occs with
-      | AllOccurrences ->
-        pr c
-      | NoOccurrences ->
-        failwith "pr_with_occurrences: no occurrences"
-      | OnlyOccurrences nl ->
-        hov 1 (pr c ++ spc () ++ keyword "at" ++ spc () ++
-                 hov 0 (prlist_with_sep spc (pr_or_var int) nl))
-      | AllOccurrencesBut nl ->
-        hov 1 (pr c ++ spc () ++ keyword "at" ++ str" - " ++
-                 hov 0 (prlist_with_sep spc (pr_or_var int) nl))
-
-  exception ComplexRedFlag
-
-  let pr_short_red_flag pr r =
-    if not r.rBeta ||  not r.rIota ||  not r.rZeta then raise ComplexRedFlag
-    else if List.is_empty r.rConst then
-      if r.rDelta then mt () else raise ComplexRedFlag
-    else (if r.rDelta then str "-" else mt ()) ++
-	   hov 0 (str "[" ++ prlist_with_sep spc pr r.rConst ++ str "]")
-
-  let pr_red_flag pr r =
-    try pr_short_red_flag pr r
-    with complexRedFlags ->
-      (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 List.is_empty 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 "]"))
-
-  let pr_union pr1 pr2 = function
-    | Inl a -> pr1 a
-    | Inr b -> pr2 b
-
-  let pr_red_expr (pr_constr,pr_lconstr,pr_ref,pr_pattern) = function
-    | Red false -> keyword "red"
-    | Hnf -> keyword "hnf"
-    | Simpl (f,o) -> keyword "simpl" ++ (pr_short_red_flag pr_ref f)
-		     ++ pr_opt (pr_with_occurrences (pr_union pr_ref pr_pattern)) o
-    | Cbv f ->
-      if f.rBeta && f.rIota && f.rZeta && f.rDelta && List.is_empty f.rConst then
-        keyword "compute"
-      else
-        hov 1 (keyword "cbv" ++ pr_red_flag pr_ref f)
-    | Lazy f ->
-      hov 1 (keyword "lazy" ++ pr_red_flag pr_ref f)
-    | Cbn f ->
-      hov 1 (keyword "cbn" ++ pr_red_flag pr_ref f)
-    | Unfold l ->
-      hov 1 (keyword "unfold" ++ spc() ++
-               prlist_with_sep pr_comma (pr_with_occurrences pr_ref) l)
-    | Fold l -> hov 1 (keyword "fold" ++ prlist (pr_arg pr_constr) l)
-    | Pattern l ->
-      hov 1 (keyword "pattern" ++
-               pr_arg (prlist_with_sep pr_comma (pr_with_occurrences pr_constr)) l)
-
-    | Red true ->
-      error "Shouldn't be accessible from user."
-    | ExtraRedExpr s ->
-      str s
-    | CbvVm o ->
-      keyword "vm_compute" ++ pr_opt (pr_with_occurrences (pr_union pr_ref pr_pattern)) o
-    | CbvNative o ->
-      keyword "native_compute" ++ pr_opt (pr_with_occurrences (pr_union pr_ref pr_pattern)) o
+  let pr_with_occurrences pr c = pr_with_occurrences pr keyword c
+  let pr_red_expr pr c = pr_red_expr pr keyword c
 
   let pr_may_eval test prc prlc pr2 pr3 = function
     | ConstrEval (r,c) ->
@@ -214,7 +136,7 @@ module Make
     | ConstrContext ((_,id),c) ->
       hov 0
         (keyword "context" ++ spc () ++ pr_id id ++ spc () ++
-           str "[" ++ prlc c ++ str "]")
+           str "[ " ++ prlc c ++ str " ]")
     | ConstrTypeOf c ->
       hov 1 (keyword "type of" ++ spc() ++ prc c)
     | ConstrTerm c when test c ->
@@ -227,10 +149,6 @@ module Make
 
   let pr_arg pr x = spc () ++ pr x
 
-  let pr_or_var pr = function
-    | ArgArg x -> pr x
-    | ArgVar (_,s) -> pr_id s
-
   let pr_and_short_name pr (c,_) = pr c
 
   let pr_or_by_notation f = function
@@ -270,8 +188,10 @@ module Make
     | NoBindings -> mt ()
 
   let pr_clear_flag clear_flag pp x =
-    (match clear_flag with Some false -> str "!" | Some true -> str ">" | None -> mt())
-    ++ pp x
+    match clear_flag with
+    | Some false -> surround (pp x)
+    | Some true -> str ">" ++ pp x
+    | None -> pp x
 
   let pr_with_bindings prc prlc (c,bl) =
     prc c ++ pr_bindings prc prlc bl
@@ -293,52 +213,6 @@ module Make
 
   let with_evars ev s = if ev then "e" ^ s else s
 
-  let hov_if_not_empty n p = if Pp.ismt p then p else hov n p
-
-  let rec pr_raw_generic_rec prc prlc prtac prpat prref (GenArg (Rawwit wit, x)) =
-    match wit with
-      | ListArg wit ->
-        let map x = pr_raw_generic_rec prc prlc prtac prpat prref (in_gen (rawwit wit) x) in
-        let ans = pr_sequence map x in
-        hov_if_not_empty 0 ans
-      | OptArg wit ->
-        let ans = match x with
-          | None -> mt ()
-          | Some x -> pr_raw_generic_rec prc prlc prtac prpat prref (in_gen (rawwit wit) x)
-        in
-        hov_if_not_empty 0 ans
-      | PairArg (wit1, wit2) ->
-        let p, q = x in
-        let p = in_gen (rawwit wit1) p in
-        let q = in_gen (rawwit wit2) q in
-        hov_if_not_empty 0 (pr_sequence (pr_raw_generic_rec prc prlc prtac prpat prref) [p; q])
-      | ExtraArg s ->
-        try pi1 (String.Map.find (ArgT.repr s) !genarg_pprule) prc prlc prtac (in_gen (rawwit wit) x)
-        with Not_found -> Genprint.generic_raw_print (in_gen (rawwit wit) x)
-
-
-  let rec pr_glb_generic_rec prc prlc prtac prpat (GenArg (Glbwit wit, x)) =
-    match wit with
-      | ListArg wit ->
-        let map x = pr_glb_generic_rec prc prlc prtac prpat (in_gen (glbwit wit) x) in
-        let ans = pr_sequence map x in
-        hov_if_not_empty 0 ans
-      | OptArg wit ->
-        let ans = match x with
-          | None -> mt ()
-          | Some x -> pr_glb_generic_rec prc prlc prtac prpat (in_gen (glbwit wit) x)
-        in
-        hov_if_not_empty 0 ans
-      | PairArg (wit1, wit2) ->
-        let p, q = x in
-        let p = in_gen (glbwit wit1) p in
-        let q = in_gen (glbwit wit2) q in
-        let ans = pr_sequence (pr_glb_generic_rec prc prlc prtac prpat) [p; q] in
-        hov_if_not_empty 0 ans
-      | ExtraArg s ->
-        try pi2 (String.Map.find (ArgT.repr s) !genarg_pprule) prc prlc prtac (in_gen (glbwit wit) x)
-        with Not_found -> Genprint.generic_glb_print (in_gen (glbwit wit) x)
-
   let rec tacarg_using_rule_token pr_gen = function
     | [] -> []
     | TacTerm s :: l -> keyword s :: tacarg_using_rule_token pr_gen l
@@ -366,6 +240,28 @@ module Make
       in
       str "<" ++ name ++ str ">" ++ args
 
+  let rec pr_user_symbol = function
+  | Extend.Ulist1 tkn -> "ne_" ^ pr_user_symbol tkn ^ "_list"
+  | Extend.Ulist1sep (tkn, _) -> "ne_" ^ pr_user_symbol tkn ^ "_list"
+  | Extend.Ulist0 tkn -> pr_user_symbol tkn ^ "_list"
+  | Extend.Ulist0sep (tkn, _) -> pr_user_symbol tkn ^ "_list"
+  | Extend.Uopt tkn -> pr_user_symbol tkn ^ "_opt"
+  | Extend.Uentry tag ->
+    let ArgT.Any tag = tag in
+    ArgT.repr tag
+  | Extend.Uentryl (tkn, lvl) -> "tactic" ^ string_of_int lvl
+
+  let pr_alias_key key =
+    try
+      let prods = (KNmap.find key !prnotation_tab).pptac_prods in
+      let rec pr = function
+      | TacTerm s -> primitive s
+      | TacNonTerm (_, symb, _) -> str (Printf.sprintf "(%s)" (pr_user_symbol symb))
+      in
+      pr_sequence pr prods
+    with Not_found ->
+      KerName.print key
+
   let pr_alias_gen pr_gen lev key l =
     try
       let pp = KNmap.find key !prnotation_tab in
@@ -506,10 +402,9 @@ module Make
 
   let pr_with_induction_names prc = function
     | None, None -> mt ()
-    | Some eqpat, None -> spc () ++ hov 1 (pr_eqn_ipat eqpat)
-    | None, Some ipat -> spc () ++ hov 1 (pr_as_disjunctive_ipat prc ipat)
+    | Some eqpat, None -> hov 1 (pr_eqn_ipat eqpat)
+    | None, Some ipat -> hov 1 (pr_as_disjunctive_ipat prc ipat)
     | Some eqpat, Some ipat ->
-      spc () ++
         hov 1 (pr_as_disjunctive_ipat prc ipat ++ spc () ++ pr_eqn_ipat eqpat)
 
   let pr_as_intro_pattern prc ipat =
@@ -550,17 +445,18 @@ module Make
     | ipat ->
       spc() ++ prc c ++ pr_as_ipat prdc ipat
 
-  let pr_by_tactic prt tac =
-    spc() ++ keyword "by" ++ spc () ++ prt tac
+  let pr_by_tactic prt = function
+    | Some tac -> keyword "by" ++ spc () ++ prt tac
+    | None -> mt()
 
   let pr_hyp_location pr_id = function
-    | occs, InHyp -> spc () ++ pr_with_occurrences pr_id occs
+    | occs, InHyp -> pr_with_occurrences pr_id occs
     | occs, InHypTypeOnly ->
-      spc () ++ pr_with_occurrences (fun id ->
+      pr_with_occurrences (fun id ->
         str "(" ++ keyword "type of" ++ spc () ++ pr_id id ++ str ")"
       ) occs
     | occs, InHypValueOnly ->
-      spc () ++ pr_with_occurrences (fun id ->
+      pr_with_occurrences (fun id ->
         str "(" ++ keyword "value of" ++ spc () ++ pr_id id ++ str ")"
       ) occs
 
@@ -574,6 +470,17 @@ module Make
     | None -> mt ()
     | Some (id,ipat) -> pr_in (spc () ++ pr_id id) ++ pr_as_ipat prc ipat
 
+  let pr_in_clause pr_id = function
+    | { onhyps=None; concl_occs=NoOccurrences } ->
+      (str "* |-")
+    | { onhyps=None; concl_occs=occs } ->
+      (pr_with_occurrences (fun () -> str "*") (occs,()))
+    | { onhyps=Some l; concl_occs=NoOccurrences } ->
+      prlist_with_sep (fun () -> str ", ") (pr_hyp_location pr_id) l
+    | { onhyps=Some l; concl_occs=occs } ->
+      let pr_occs = pr_with_occurrences (fun () -> str" |- *") (occs,()) in
+      (prlist_with_sep (fun () -> str", ") (pr_hyp_location pr_id) l ++ pr_occs)
+
   let pr_clauses default_is_concl pr_id = function
     | { onhyps=Some []; concl_occs=occs }
         when (match default_is_concl with Some true -> true | _ -> false) ->
@@ -590,7 +497,8 @@ module Make
         | _ -> pr_with_occurrences (fun () -> str" |- *") (occs,())
       in
       pr_in
-        (prlist_with_sep (fun () -> str",") (pr_hyp_location pr_id) l ++ pr_occs)
+        (prlist_with_sep (fun () -> str",")
+           (fun id -> spc () ++ pr_hyp_location pr_id id) l ++ pr_occs)
 
   let pr_orient b = if b then mt () else str "<- "
 
@@ -601,16 +509,30 @@ module Make
     | RepeatStar -> str "?"
     | RepeatPlus -> str "!"
 
-  let pr_induction_arg prc prlc = function
+  let pr_core_destruction_arg prc prlc = function
     | ElimOnConstr c -> pr_with_bindings prc prlc c
     | ElimOnIdent (loc,id) -> pr_with_comments loc (pr_id id)
     | ElimOnAnonHyp n -> int n
 
-  let pr_induction_kind = function
+  let pr_destruction_arg prc prlc (clear_flag,h) =
+    pr_clear_flag clear_flag (pr_core_destruction_arg prc prlc) h
+                               
+  let pr_inversion_kind = function
     | SimpleInversion -> primitive "simple inversion"
     | FullInversion -> primitive "inversion"
     | FullInversionClear -> primitive "inversion_clear"
 
+  let pr_range_selector (i, j) =
+    if Int.equal i j then int i
+    else int i ++ str "-" ++ int j
+
+  let pr_goal_selector = function
+    | SelectNth i -> int i ++ str ":"
+    | SelectList l -> str "[" ++ prlist_with_sep (fun () -> str ", ") pr_range_selector l ++
+        str "]" ++ str ":"
+    | SelectId id -> str "[" ++ Nameops.pr_id id ++ str "]" ++ str ":"
+    | SelectAll -> str "all" ++ str ":"
+
   let pr_lazy = function
     | General -> keyword "multi"
     | Select -> keyword "lazy"
@@ -621,9 +543,9 @@ module Make
     | Subterm (b,None,a) ->
     (** ppedrot: we don't make difference between [appcontext] and [context]
         anymore, and the interpretation is governed by a flag instead. *)
-      keyword "context" ++ str" [" ++ pr_pat a ++ str "]"
+      keyword "context" ++ str" [ " ++ pr_pat a ++ str " ]"
     | Subterm (b,Some id,a) ->
-      keyword "context" ++ spc () ++ pr_id id ++ str "[" ++ pr_pat a ++ str "]"
+      keyword "context" ++ spc () ++ pr_id id ++ str "[ " ++ pr_pat a ++ str " ]"
 
   let pr_match_hyps pr_pat = function
     | Hyp (nal,mp) ->
@@ -759,7 +681,7 @@ module Make
       let pr_with_bindings_arg = pr_with_bindings_arg pr.pr_constr pr.pr_lconstr in
       let pr_red_expr = pr_red_expr (pr.pr_constr,pr.pr_lconstr,pr.pr_constant,pr.pr_pattern) in
 
-      let pr_constrarg c = spc () ++ pr.pr_constr c in
+      let _pr_constrarg c = spc () ++ pr.pr_constr c in
       let pr_lconstrarg c = spc () ++ pr.pr_lconstr c in
       let pr_intarg n = spc () ++ int n in
 
@@ -807,7 +729,7 @@ module Make
                   prlist pr_binder_fix bll ++ annot ++ str" :" ++
                   pr_lconstrarg ty ++ str")") in
       (*  spc() ++
-          hov 0 (pr_id id ++ pr_intarg n ++ str":" ++ pr_constrarg
+          hov 0 (pr_id id ++ pr_intarg n ++ str":" ++ _pr_constrarg
           c)
       *)
       let pr_cofix_tac (id,c) =
@@ -815,28 +737,19 @@ module Make
 
       (* Printing tactics as arguments *)
       let rec pr_atom0 a = tag_atom a (match a with
-        | TacIntroPattern [] -> primitive "intros"
-        | TacIntroMove (None,MoveLast) -> primitive "intro"
+        | TacIntroPattern (false,[]) -> primitive "intros"
+        | TacIntroPattern (true,[]) -> primitive "eintros"
         | t -> str "(" ++ pr_atom1 t ++ str ")"
       )
 
       (* Main tactic printer *)
       and pr_atom1 a = tag_atom a (match a with
         (* Basic tactics *)
-        | TacIntroPattern [] as t ->
+        | TacIntroPattern (ev,[]) as t ->
           pr_atom0 t
-        | TacIntroPattern (_::_ as p) ->
-          hov 1 (primitive "intros" ++ spc () ++
+        | TacIntroPattern (ev,(_::_ as p)) ->
+           hov 1 (primitive (if ev then "eintros" else "intros") ++ spc () ++
                     prlist_with_sep spc (Miscprint.pr_intro_pattern pr.pr_dconstr) p)
-        | TacIntroMove (None,MoveLast) as t ->
-          pr_atom0 t
-        | TacIntroMove (Some id,MoveLast) ->
-          primitive "intro" ++ spc () ++ pr_id id
-        | TacIntroMove (ido,hto) ->
-          hov 1 (primitive "intro" ++ pr_opt pr_id ido ++
-                    Miscprint.pr_move_location pr.pr_name hto)
-        | TacExact c ->
-          hov 1 (primitive "exact" ++ pr_constrarg c)
         | TacApply (a,ev,cb,inhyp) ->
           hov 1 (
             (if a then mt() else primitive "simple ") ++
@@ -864,7 +777,7 @@ module Make
           hov 1 (
             primitive (if b then "assert" else "enough") ++
               pr_assumption pr.pr_constr pr.pr_dconstr pr.pr_lconstr ipat c ++
-              pr_by_tactic (pr.pr_tactic ltop) tac
+              pr_non_empty_arg (pr_by_tactic (pr.pr_tactic (ltactical,E))) tac
           )
         | TacAssert (_,None,ipat,c) ->
           hov 1 (
@@ -903,29 +816,12 @@ module Make
           hov 1 (
             primitive (with_evars ev (if isrec then "induction" else "destruct"))
             ++ spc ()
-            ++ prlist_with_sep pr_comma (fun ((clear_flag,h),ids,cl) ->
-              pr_clear_flag clear_flag (pr_induction_arg pr.pr_dconstr pr.pr_dconstr) h ++
-                pr_with_induction_names pr.pr_dconstr ids ++
+            ++ prlist_with_sep pr_comma (fun (h,ids,cl) ->
+              pr_destruction_arg pr.pr_dconstr pr.pr_dconstr h ++
+                pr_non_empty_arg (pr_with_induction_names pr.pr_dconstr) ids ++
                 pr_opt (pr_clauses None pr.pr_name) cl) l ++
               pr_opt pr_eliminator el
           )
-        | TacDoubleInduction (h1,h2) ->
-          hov 1 (
-            primitive "double induction"
-            ++ pr_arg pr_quantified_hypothesis h1
-            ++ pr_arg pr_quantified_hypothesis h2
-          )
-
-        (* Context management *)
-        | TacRename l ->
-          hov 1 (
-            primitive "rename" ++ brk (1,1)
-            ++ prlist_with_sep
-              (fun () -> str "," ++ brk (1,1))
-              (fun (i1,i2) ->
-                pr.pr_name i1 ++ spc () ++ str "into" ++ spc () ++ pr.pr_name i2)
-              l
-          )
 
         (* Conversion *)
         | TacReduce (r,h) ->
@@ -947,7 +843,7 @@ module Make
           )
 
         (* Equality and inversion *)
-        | TacRewrite (ev,l,cl,by) ->
+        | TacRewrite (ev,l,cl,tac) ->
           hov 1 (
             primitive (with_evars ev "rewrite") ++ spc ()
             ++ prlist_with_sep
@@ -957,24 +853,20 @@ module Make
                   pr_with_bindings_arg_full pr.pr_dconstr pr.pr_dconstr c)
               l
             ++ pr_non_empty_arg (pr_clauses (Some true) pr.pr_name) cl
-            ++ (
-              match by with
-                | Some by -> pr_by_tactic (pr.pr_tactic ltop) by
-                | None -> mt()
-            )
+            ++ pr_non_empty_arg (pr_by_tactic (pr.pr_tactic (ltactical,E))) tac
           )
         | TacInversion (DepInversion (k,c,ids),hyp) ->
           hov 1 (
-            primitive "dependent " ++ pr_induction_kind k ++ spc ()
+            primitive "dependent " ++ pr_inversion_kind k ++ spc ()
             ++ pr_quantified_hypothesis hyp
             ++ pr_with_inversion_names pr.pr_dconstr ids
             ++ pr_with_constr pr.pr_constr c
           )
         | TacInversion (NonDepInversion (k,cl,ids),hyp) ->
           hov 1 (
-            pr_induction_kind k ++ spc ()
+            pr_inversion_kind k ++ spc ()
             ++ pr_quantified_hypothesis hyp
-            ++ pr_with_inversion_names pr.pr_dconstr ids
+            ++ pr_non_empty_arg (pr_with_inversion_names pr.pr_dconstr) ids
             ++ pr_non_empty_arg (pr_simple_hyp_clause pr.pr_name) cl
           )
         | TacInversion (InversionUsing (c,cl),hyp) ->
@@ -1147,6 +1039,7 @@ module Make
               keyword "solve" ++ spc () ++ pr_seq_body (pr_tac ltop) tl, llet
             | TacComplete t ->
               pr_tac (lcomplete,E) t, lcomplete
+            | TacSelect (s, tac) -> pr_goal_selector s ++ spc () ++ pr_tac ltop tac, latom
             | TacId l ->
               keyword "idtac" ++ prlist (pr_arg (pr_message_token pr.pr_name)) l, latom
             | TacAtom (loc,t) ->
@@ -1191,7 +1084,7 @@ module Make
           | TacNumgoals ->
             keyword "numgoals"
           | (TacCall _|Tacexp _ | TacGeneric _) as a ->
-            keyword "ltac:" ++ pr_tac (latom,E) (TacArg (Loc.ghost,a))
+            hov 0 (keyword "ltac:" ++ surround (pr_tac ltop (TacArg (Loc.ghost,a))))
 
         in pr_tac
 
@@ -1218,7 +1111,7 @@ module Make
       pr_constant = pr_or_by_notation pr_reference;
       pr_reference = pr_reference;
       pr_name = pr_lident;
-      pr_generic = pr_raw_generic_rec pr_constr_expr pr_lconstr_expr pr_raw_tactic_level pr_constr_pattern_expr pr_reference;
+      pr_generic = (fun arg -> Pputils.pr_raw_generic (Global.env ()) arg);
       pr_extend = pr_raw_extend_rec pr_constr_expr pr_lconstr_expr pr_raw_tactic_level pr_constr_pattern_expr;
       pr_alias = pr_raw_alias pr_constr_expr pr_lconstr_expr pr_raw_tactic_level pr_constr_pattern_expr;
     } in
@@ -1248,9 +1141,7 @@ module Make
         pr_constant = pr_or_var (pr_and_short_name (pr_evaluable_reference_env env));
         pr_reference = pr_ltac_or_var (pr_located pr_ltac_constant);
         pr_name = pr_lident;
-        pr_generic = pr_glb_generic_rec
-          (pr_and_constr_expr (pr_glob_constr_env env)) (pr_and_constr_expr (pr_lglob_constr_env env))
-          prtac (pr_pat_and_constr_expr (pr_glob_constr_env env));
+        pr_generic = (fun arg -> Pputils.pr_glb_generic (Global.env ()) arg);
         pr_extend = pr_glob_extend_rec
           (pr_and_constr_expr (pr_glob_constr_env env)) (pr_and_constr_expr (pr_lglob_constr_env env))
           prtac (pr_pat_and_constr_expr (pr_glob_constr_env env));
@@ -1298,12 +1189,9 @@ module Make
     in
     prtac n t
 
-  let pr_raw_generic env = pr_raw_generic_rec
-    pr_constr_expr pr_lconstr_expr pr_raw_tactic_level pr_constr_pattern_expr pr_reference
+  let pr_raw_generic = Pputils.pr_raw_generic
 
-  let pr_glb_generic env = pr_glb_generic_rec
-    (pr_and_constr_expr (pr_glob_constr_env env)) (pr_and_constr_expr (pr_lglob_constr_env env))
-    (pr_glob_tactic_level env) (pr_pat_and_constr_expr (pr_glob_constr_env env))
+  let pr_glb_generic = Pputils.pr_glb_generic
 
   let pr_raw_extend env = pr_raw_extend_rec
     pr_constr_expr pr_lconstr_expr pr_raw_tactic_level pr_constr_pattern_expr
@@ -1351,65 +1239,93 @@ include Make (Ppconstr) (struct
     let tag_atomic_tactic_expr      = do_not_tag
 end)
 
+let declare_extra_genarg_pprule wit
+  (f : 'a raw_extra_genarg_printer)
+  (g : 'b glob_extra_genarg_printer)
+  (h : 'c extra_genarg_printer) =
+  begin match wit with
+    | ExtraArg s -> ()
+    | _          -> error "Can declare a pretty-printing rule only for extra argument types."
+  end;
+  let f x = f pr_constr_expr pr_lconstr_expr pr_raw_tactic_level x in
+  let g x =
+    let env = Global.env () in
+    g (pr_and_constr_expr (pr_glob_constr_env env)) (pr_and_constr_expr (pr_lglob_constr_env env)) (pr_glob_tactic_level env) x
+  in
+  let h x =
+    let env = Global.env () in
+    h (pr_constr_env env Evd.empty) (pr_lconstr_env env Evd.empty) (fun _ _ -> str "<tactic>") x
+  in
+  Genprint.register_print0 wit f g h
+
 (** Registering *)
 
 let run_delayed c =
   Sigma.run Evd.empty { Sigma.run = fun sigma -> c.delayed (Global.env ()) sigma }
 
+let run_delayed_destruction_arg = function (* HH: Using Evd.empty looks suspicious *)
+  | clear_flag,ElimOnConstr g -> clear_flag,ElimOnConstr (fst (run_delayed g))
+  | clear_flag,ElimOnAnonHyp n as x -> x
+  | clear_flag,ElimOnIdent id as x -> x
+
 let () =
   let pr_bool b = if b then str "true" else str "false" in
   let pr_unit _ = str "()" in
   let pr_string s = str "\"" ++ str s ++ str "\"" in
-  Genprint.register_print0 Constrarg.wit_int_or_var
+  Genprint.register_print0 wit_int_or_var
     (pr_or_var int) (pr_or_var int) int;
-  Genprint.register_print0 Constrarg.wit_ref
+  Genprint.register_print0 wit_ref
     pr_reference (pr_or_var (pr_located pr_global)) pr_global;
-  Genprint.register_print0 Constrarg.wit_ident
+  Genprint.register_print0 wit_ident
     pr_id pr_id pr_id;
-  Genprint.register_print0 Constrarg.wit_var
+  Genprint.register_print0 wit_var
     (pr_located pr_id) (pr_located pr_id) pr_id;
   Genprint.register_print0
-    Constrarg.wit_intro_pattern
+    wit_intro_pattern
     (Miscprint.pr_intro_pattern pr_constr_expr)
     (Miscprint.pr_intro_pattern (fun (c,_) -> pr_glob_constr c))
     (Miscprint.pr_intro_pattern (fun c -> pr_constr (fst (run_delayed c))));
   Genprint.register_print0
-    Constrarg.wit_clause_dft_concl
+    wit_clause_dft_concl
     (pr_clauses (Some true) pr_lident)
     (pr_clauses (Some true) pr_lident)
     (pr_clauses (Some true) (fun id -> pr_lident (Loc.ghost,id)))
   ;
   Genprint.register_print0
-    Constrarg.wit_constr
+    wit_constr
     Ppconstr.pr_constr_expr
     (fun (c, _) -> Printer.pr_glob_constr c)
     Printer.pr_constr
   ;
   Genprint.register_print0
-    Constrarg.wit_uconstr
+    wit_uconstr
     Ppconstr.pr_constr_expr
     (fun (c,_) -> Printer.pr_glob_constr c)
     Printer.pr_closed_glob
   ;
   Genprint.register_print0
-    Constrarg.wit_open_constr
+    wit_open_constr
     Ppconstr.pr_constr_expr
     (fun (c, _) -> Printer.pr_glob_constr c)
     Printer.pr_constr
   ;
-  Genprint.register_print0 Constrarg.wit_red_expr
+  Genprint.register_print0 wit_red_expr
     (pr_red_expr (pr_constr_expr, pr_lconstr_expr, pr_or_by_notation pr_reference, pr_constr_pattern_expr))
-    (pr_red_expr (pr_and_constr_expr pr_glob_constr, pr_lglob_constr, pr_or_var (pr_and_short_name pr_evaluable_reference), pr_pat_and_constr_expr pr_glob_constr))
+    (pr_red_expr (pr_and_constr_expr pr_glob_constr, pr_and_constr_expr pr_lglob_constr, pr_or_var (pr_and_short_name pr_evaluable_reference), pr_pat_and_constr_expr pr_glob_constr))
     (pr_red_expr (pr_constr, pr_lconstr, pr_evaluable_reference, pr_constr_pattern));
-  Genprint.register_print0 Constrarg.wit_quant_hyp pr_quantified_hypothesis pr_quantified_hypothesis pr_quantified_hypothesis;
-  Genprint.register_print0 Constrarg.wit_bindings
+  Genprint.register_print0 wit_quant_hyp pr_quantified_hypothesis pr_quantified_hypothesis pr_quantified_hypothesis;
+  Genprint.register_print0 wit_bindings
     (pr_bindings_no_with pr_constr_expr pr_lconstr_expr)
     (pr_bindings_no_with (pr_and_constr_expr pr_glob_constr) (pr_and_constr_expr pr_lglob_constr))
     (fun it -> pr_bindings_no_with pr_constr pr_lconstr (fst (run_delayed it)));
-  Genprint.register_print0 Constrarg.wit_constr_with_bindings
+  Genprint.register_print0 wit_constr_with_bindings
     (pr_with_bindings pr_constr_expr pr_lconstr_expr)
     (pr_with_bindings (pr_and_constr_expr pr_glob_constr) (pr_and_constr_expr pr_lglob_constr))
     (fun it -> pr_with_bindings pr_constr pr_lconstr (fst (run_delayed it)));
+  Genprint.register_print0 Tacarg.wit_destruction_arg
+    (pr_destruction_arg pr_constr_expr pr_lconstr_expr)
+    (pr_destruction_arg (pr_and_constr_expr pr_glob_constr) (pr_and_constr_expr pr_lglob_constr))
+    (fun it -> pr_destruction_arg pr_constr pr_lconstr (run_delayed_destruction_arg it));
   Genprint.register_print0 Stdarg.wit_int int int int;
   Genprint.register_print0 Stdarg.wit_bool pr_bool pr_bool pr_bool;
   Genprint.register_print0 Stdarg.wit_unit pr_unit pr_unit pr_unit;
@@ -1429,16 +1345,17 @@ module Richpp = struct
 
   include Make (Ppconstr.Richpp) (struct
     open Ppannotation
+    open Genarg
     let do_not_tag _ x = x
     let tag e s = Pp.tag (Pp.Tag.inj e tag) s
     let tag_keyword                   = tag AKeyword
     let tag_primitive                 = tag AKeyword
     let tag_string                    = do_not_tag ()
-    let tag_glob_tactic_expr        e = tag (AGlobTacticExpr e)
-    let tag_glob_atomic_tactic_expr a = tag (AGlobAtomicTacticExpr a)
-    let tag_raw_tactic_expr         e = tag (ARawTacticExpr e)
-    let tag_raw_atomic_tactic_expr  a = tag (ARawAtomicTacticExpr a)
-    let tag_atomic_tactic_expr      a = tag (AAtomicTacticExpr a)
+    let tag_glob_tactic_expr        e = tag (AGlbGenArg (in_gen (glbwit wit_ltac) e))
+    let tag_glob_atomic_tactic_expr   = do_not_tag
+    let tag_raw_tactic_expr         e = tag (ARawGenArg (in_gen (rawwit wit_ltac) e))
+    let tag_raw_atomic_tactic_expr    = do_not_tag
+    let tag_atomic_tactic_expr        = do_not_tag
   end)
 
 end
diff --git a/printing/pptactic.mli b/ltac/pptactic.mli
index 86e3ea548..86e3ea548 100644
--- a/printing/pptactic.mli
+++ b/ltac/pptactic.mli
diff --git a/printing/pptacticsig.mli b/ltac/pptacticsig.mli
index 4ef2ea918..74ddd377a 100644
--- a/printing/pptacticsig.mli
+++ b/ltac/pptacticsig.mli
@@ -25,9 +25,10 @@ module type Pp = sig
     ('a -> std_ppcmds) -> ('a -> std_ppcmds) -> ('b -> std_ppcmds) ->
     ('c -> std_ppcmds) -> ('a,'b,'c) Genredexpr.may_eval -> std_ppcmds
 
-  val pr_or_var : ('a -> std_ppcmds) -> 'a or_var -> std_ppcmds
   val pr_and_short_name : ('a -> std_ppcmds) -> 'a and_short_name -> std_ppcmds
-  val pr_or_by_notation : ('a -> std_ppcmds) -> 'a or_by_notation -> std_ppcmds
+
+  val pr_in_clause :
+    ('a -> Pp.std_ppcmds) -> 'a Locus.clause_expr -> Pp.std_ppcmds
 
   val pr_clauses :  bool option ->
     ('a -> Pp.std_ppcmds) -> 'a Locus.clause_expr -> Pp.std_ppcmds
@@ -45,9 +46,13 @@ module type Pp = sig
   val pr_extend :
     (Val.t -> std_ppcmds) -> int -> ml_tactic_entry -> Val.t list -> std_ppcmds
 
+  val pr_alias_key : Names.KerName.t -> std_ppcmds
+
   val pr_alias : (Val.t -> std_ppcmds) ->
     int -> Names.KerName.t -> Val.t list -> std_ppcmds
 
+  val pr_alias_key : Names.KerName.t -> std_ppcmds
+
   val pr_ltac_constant : Nametab.ltac_constant -> std_ppcmds
 
   val pr_raw_tactic : raw_tactic_expr -> std_ppcmds
diff --git a/ltac/profile_ltac.ml b/ltac/profile_ltac.ml
new file mode 100644
index 000000000..2514ededb
--- /dev/null
+++ b/ltac/profile_ltac.ml
@@ -0,0 +1,420 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+open Unicode
+open Pp
+open Printer
+open Util
+
+module M = CString.Map
+
+(** [is_profiling] and the profiling info ([stack]) should be synchronized with
+    the document; the rest of the ref cells are either local to individual
+    tactic invocations, or global flags, and need not be synchronized, since no
+    document-level backtracking happens within tactics. We synchronize
+    is_profiling via an option. *)
+let is_profiling = Flags.profile_ltac
+
+let set_profiling b = is_profiling := b
+let get_profiling () = !is_profiling
+
+(** LtacProf cannot yet handle backtracking into multi-success tactics.
+    To properly support this, we'd have to somehow recreate our location in the
+    call-stack, and stop/restart the intervening timers. This is tricky and
+    possibly expensive, so instead we currently just emit a warning that
+    profiling results will be off. *)
+let encountered_multi_success_backtracking = ref false
+
+let warn_profile_backtracking =
+  CWarnings.create ~name:"profile-backtracking" ~category:"ltac"
+    (fun () -> strbrk "Ltac Profiler cannot yet handle backtracking \
+       into multi-success tactics; profiling results may be wildly inaccurate.")
+
+let warn_encountered_multi_success_backtracking () =
+  if !encountered_multi_success_backtracking then
+    warn_profile_backtracking ()
+
+let encounter_multi_success_backtracking () =
+  if not !encountered_multi_success_backtracking
+  then begin
+    encountered_multi_success_backtracking := true;
+    warn_encountered_multi_success_backtracking ()
+  end
+
+
+(* *************** tree data structure for profiling ****************** *)
+
+type treenode = {
+  name : M.key;
+  total : float;
+  local : float;
+  ncalls : int;
+  max_total : float;
+  children : treenode M.t
+}
+
+let empty_treenode name = {
+  name;
+  total = 0.0;
+  local = 0.0;
+  ncalls = 0;
+  max_total = 0.0;
+  children = M.empty;
+}
+
+let root = "root"
+
+module Local = Summary.Local
+
+let stack = Local.ref ~name:"LtacProf-stack" [empty_treenode root]
+
+let reset_profile_tmp () =
+  Local.(stack := [empty_treenode root]);
+  encountered_multi_success_backtracking := false
+
+(* ************** XML Serialization  ********************* *)
+
+let rec of_ltacprof_tactic (name, t) =
+  assert (String.equal name t.name);
+  let open Xml_datatype in
+  let total = string_of_float t.total in
+  let local = string_of_float t.local in
+  let ncalls = string_of_int t.ncalls in
+  let max_total = string_of_float t.max_total in
+  let children = List.map of_ltacprof_tactic (M.bindings t.children) in
+  Element ("ltacprof_tactic",
+    [ ("name", name); ("total",total); ("local",local);
+      ("ncalls",ncalls); ("max_total",max_total)],
+    children)
+
+let of_ltacprof_results t =
+  let open Xml_datatype in
+  assert(String.equal t.name root);
+  let children = List.map of_ltacprof_tactic (M.bindings t.children) in
+  Element ("ltacprof", [("total_time", string_of_float t.total)], children)
+
+let rec to_ltacprof_tactic m xml =
+  let open Xml_datatype in
+  match xml with
+  | Element ("ltacprof_tactic",
+     [("name", name); ("total",total); ("local",local);
+      ("ncalls",ncalls); ("max_total",max_total)], xs) ->
+      let node = {
+         name;
+         total = float_of_string total;
+         local = float_of_string local;
+         ncalls = int_of_string ncalls;
+         max_total = float_of_string max_total;
+         children = List.fold_left to_ltacprof_tactic M.empty xs;
+       } in
+      M.add name node m
+  | _ -> CErrors.anomaly Pp.(str "Malformed ltacprof_tactic XML")
+
+let to_ltacprof_results xml =
+  let open Xml_datatype in
+  match xml with
+  | Element ("ltacprof", [("total_time", t)], xs) ->
+     { name = root;
+       total = float_of_string t;
+       ncalls = 0;
+       max_total = 0.0;
+       local = 0.0;
+       children = List.fold_left to_ltacprof_tactic M.empty xs }
+  | _ -> CErrors.anomaly Pp.(str "Malformed ltacprof XML")
+
+let feedback_results results =
+  Feedback.(feedback
+    (Custom (Loc.dummy_loc, "ltacprof_results", of_ltacprof_results results)))
+
+(* ************** pretty printing ************************************* *)
+
+let format_sec x = (Printf.sprintf "%.3fs" x)
+let format_ratio x = (Printf.sprintf "%.1f%%" (100. *. x))
+let padl n s = ws (max 0 (n - utf8_length s)) ++ str s
+let padr n s = str s ++ ws (max 0 (n - utf8_length s))
+let padr_with c n s =
+  let ulength = utf8_length s in
+  str (utf8_sub s 0 n) ++ str (String.make (max 0 (n - ulength)) c)
+
+let rec list_iter_is_last f = function
+  | []      -> []
+  | [x]     -> [f true x]
+  | x :: xs -> f false x :: list_iter_is_last f xs
+
+let header =
+  str " tactic                                   local  total   calls       max " ++
+  fnl () ++
+  str "────────────────────────────────────────┴──────┴──────┴───────┴─────────┘" ++
+  fnl ()
+
+let rec print_node ~filter all_total indent prefix (s, e) =
+  h 0 (
+    padr_with '-' 40 (prefix ^ s ^ " ")
+    ++ padl 7 (format_ratio (e.local /. all_total))
+    ++ padl 7 (format_ratio (e.total /. all_total))
+    ++ padl 8 (string_of_int e.ncalls)
+    ++ padl 10 (format_sec (e.max_total))
+  ) ++
+  fnl () ++
+  print_table ~filter all_total indent false e.children
+
+and print_table ~filter all_total indent first_level table =
+  let fold _ n l =
+    let s, total = n.name, n.total in
+    if filter s total then (s, n) :: l else l in
+  let ls = M.fold fold table [] in
+  match ls with
+  | [s, n] when not first_level ->
+     v 0 (print_node ~filter all_total indent (indent ^ "└") (s, n))
+  | _ ->
+    let ls =
+      List.sort (fun (_, { total = s1 }) (_, { total = s2}) ->
+                   compare s2 s1) ls in
+    let iter is_last =
+     let sep0 = if first_level then "" else if is_last then "  " else " │" in
+     let sep1 = if first_level then "─" else if is_last then " └─" else " ├─" in
+     print_node ~filter all_total (indent ^ sep0) (indent ^ sep1)
+    in
+    prlist (fun pr -> pr) (list_iter_is_last iter ls)
+
+let to_string ~filter ?(cutoff=0.0) node =
+  let tree = node.children in
+  let all_total = M.fold (fun _ { total } a -> total +. a) node.children 0.0 in
+  let flat_tree =
+    let global = ref M.empty in
+    let find_tactic tname l =
+      try M.find tname !global
+      with Not_found ->
+        let e = empty_treenode tname in
+        global := M.add tname e !global;
+        e in
+    let add_tactic tname stats = global := M.add tname stats !global in
+    let sum_stats add_total
+      { name; total = t1; local = l1; ncalls = n1; max_total = m1 }
+      {       total = t2; local = l2; ncalls = n2; max_total = m2 } = {
+          name;
+          total = if add_total then t1 +. t2 else t1;
+          local = l1 +. l2;
+          ncalls = n1 + n2;
+          max_total = if add_total then max m1 m2 else m1;
+          children = M.empty;
+      } in
+    let rec cumulate table =
+      let iter _ ({ name; children } as statistics) =
+        if filter name then begin
+          let stats' = find_tactic name global in
+          add_tactic name (sum_stats true stats' statistics);
+        end;
+        cumulate children
+      in
+      M.iter iter table
+    in
+    cumulate tree;
+    !global
+  in
+  warn_encountered_multi_success_backtracking ();
+  let filter s n = filter s && (all_total <= 0.0 || n /. all_total >= cutoff /. 100.0) in
+  let msg =
+    h 0 (str "total time: " ++ padl 11 (format_sec (all_total))) ++
+    fnl () ++
+    fnl () ++
+    header ++
+    print_table ~filter all_total "" true flat_tree ++
+    fnl () ++
+    header ++
+    print_table ~filter all_total "" true tree
+  in
+  msg
+
+(* ******************** profiling code ************************************** *)
+
+let get_child name node =
+  try M.find name node.children
+  with Not_found -> empty_treenode name
+
+let time () =
+  let times = Unix.times () in
+  times.Unix.tms_utime +. times.Unix.tms_stime
+
+let string_of_call ck =
+  let s =
+  string_of_ppcmds
+    (match ck with
+       | Tacexpr.LtacNotationCall s -> Pptactic.pr_alias_key s
+       | Tacexpr.LtacNameCall cst -> Pptactic.pr_ltac_constant cst
+       | Tacexpr.LtacVarCall (id, t) -> Nameops.pr_id id
+       | Tacexpr.LtacAtomCall te ->
+         (Pptactic.pr_glob_tactic (Global.env ())
+            (Tacexpr.TacAtom (Loc.ghost, te)))
+       | Tacexpr.LtacConstrInterp (c, _) ->
+         pr_glob_constr_env (Global.env ()) c
+       | Tacexpr.LtacMLCall te ->
+         (Pptactic.pr_glob_tactic (Global.env ())
+            te)
+    ) in
+  for i = 0 to String.length s - 1 do if s.[i] = '\n' then s.[i] <- ' ' done;
+  let s = try String.sub s 0 (CString.string_index_from s 0 "(*") with Not_found -> s in
+  CString.strip s
+
+let rec merge_sub_tree name tree acc =
+  try
+    let t = M.find name acc in
+    let t = {
+      name;
+      total = t.total +. tree.total;
+      ncalls = t.ncalls + tree.ncalls;
+      local = t.local +. tree.local;
+      max_total = max t.max_total tree.max_total;
+      children = M.fold merge_sub_tree tree.children t.children;
+    } in
+    M.add name t acc
+  with Not_found -> M.add name tree acc
+
+let merge_roots ?(disjoint=true) t1 t2 =
+  assert(String.equal t1.name t2.name);
+  { name = t1.name;
+    ncalls = t1.ncalls + t2.ncalls;
+    local = if disjoint then t1.local +. t2.local else t1.local;
+    total = if disjoint then t1.total +. t2.total else t1.total;
+    max_total = if disjoint then max t1.max_total t2.max_total else t1.max_total;
+    children =
+      M.fold merge_sub_tree t2.children t1.children }
+
+let rec find_in_stack what acc = function
+  | [] -> None
+  | { name } as x :: rest when String.equal name what -> Some(acc, x, rest)
+  | { name } as x :: rest -> find_in_stack what (x :: acc) rest
+
+let exit_tactic start_time c =
+  let diff = time () -. start_time in
+  match Local.(!stack) with
+  | [] | [_] ->
+    (* oops, our stack is invalid *)
+    encounter_multi_success_backtracking ();
+    reset_profile_tmp ()
+  | node :: (parent :: rest as full_stack) ->
+    let name = string_of_call c in
+    if not (String.equal name node.name) then
+      (* oops, our stack is invalid *)
+      encounter_multi_success_backtracking ();
+    let node = { node with
+      total = node.total +. diff;
+      local = node.local +. diff;
+      ncalls = node.ncalls + 1;
+      max_total = max node.max_total diff;
+    } in
+    (* updating the stack *)
+    let parent =
+      match find_in_stack node.name [] full_stack with
+      | None ->
+         (* no rec-call, we graft the subtree *)
+         let parent = { parent with
+           local = parent.local -. diff;
+           children = M.add node.name node parent.children } in
+         Local.(stack := parent :: rest);
+         parent
+      | Some(to_update, self, rest) ->
+         (* we coalesce the rec-call and update the lower stack *)
+         let self = merge_roots ~disjoint:false self node in
+         let updated_stack =
+           List.fold_left (fun s x ->
+             (try M.find x.name (List.hd s).children
+              with Not_found -> x) :: s) (self :: rest) to_update in
+         Local.(stack := updated_stack);
+         List.hd Local.(!stack)
+    in
+    (* Calls are over, we reset the stack and send back data *)
+    if rest == [] && get_profiling () then begin
+      assert(String.equal root parent.name);
+      reset_profile_tmp ();
+      feedback_results parent
+    end
+
+let tclFINALLY tac (finally : unit Proofview.tactic) =
+  let open Proofview.Notations in
+  Proofview.tclIFCATCH
+    tac
+    (fun v -> finally <*> Proofview.tclUNIT v)
+    (fun (exn, info) -> finally <*> Proofview.tclZERO ~info exn)
+
+let do_profile s call_trace tac =
+  let open Proofview.Notations in
+  Proofview.tclLIFT (Proofview.NonLogical.make (fun () ->
+  if !is_profiling then
+    match call_trace, Local.(!stack) with
+      | (_, c) :: _, parent :: rest ->
+        let name = string_of_call c in
+        let node = get_child name parent in
+        Local.(stack := node :: parent :: rest);
+        Some (time ())
+      | _ :: _, [] -> assert false
+      | _ -> None
+  else None)) >>= function
+  | Some start_time ->
+    tclFINALLY
+      tac
+      (Proofview.tclLIFT (Proofview.NonLogical.make (fun () ->
+        (match call_trace with
+        | (_, c) :: _ -> exit_tactic start_time c
+        | [] -> ()))))
+  | None -> tac
+
+(* ************** Accumulation of data from workers ************************* *)
+
+let get_local_profiling_results () = List.hd Local.(!stack)
+
+module SM = Map.Make(Stateid.Self)
+
+let data = ref SM.empty
+
+let _ =
+  Feedback.(add_feeder (function
+    | { id = State s; contents = Custom (_, "ltacprof_results", xml) } ->
+        let results = to_ltacprof_results xml in
+        let other_results = (* Multi success can cause this *)
+          try SM.find s !data
+          with Not_found -> empty_treenode root in
+        data := SM.add s (merge_roots results other_results) !data
+    | _ -> ()))
+
+let reset_profile () =
+  reset_profile_tmp ();
+  data := SM.empty
+
+(* ******************** *)
+
+let print_results_filter ~cutoff ~filter =
+  let valid id _ = Stm.state_of_id id <> `Expired in
+  data := SM.filter valid !data;
+  let results =
+    SM.fold (fun _ -> merge_roots ~disjoint:true) !data (empty_treenode root) in
+  let results = merge_roots results Local.(CList.last !stack) in
+  Feedback.msg_notice (to_string ~cutoff ~filter results)
+;;
+
+let print_results ~cutoff =
+  print_results_filter ~cutoff ~filter:(fun _ -> true)
+
+let print_results_tactic tactic =
+  print_results_filter ~cutoff:!Flags.profile_ltac_cutoff ~filter:(fun s ->
+    String.(equal tactic (sub (s ^ ".") 0 (min (1+length s) (length tactic)))))
+
+let do_print_results_at_close () =
+  if get_profiling () then print_results ~cutoff:!Flags.profile_ltac_cutoff
+
+let _ = Declaremods.append_end_library_hook do_print_results_at_close
+
+let _ =
+  let open Goptions in
+  declare_bool_option
+    { optsync  = true;
+      optdepr  = false;
+      optname  = "Ltac Profiling";
+      optkey   = ["Ltac"; "Profiling"];
+      optread  = get_profiling;
+      optwrite = set_profiling }
diff --git a/ltac/profile_ltac.mli b/ltac/profile_ltac.mli
new file mode 100644
index 000000000..e5e2e4197
--- /dev/null
+++ b/ltac/profile_ltac.mli
@@ -0,0 +1,48 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+(** Ltac profiling primitives *)
+
+val do_profile :
+  string -> ('a * Tacexpr.ltac_call_kind) list ->
+    'b Proofview.tactic -> 'b Proofview.tactic
+
+val set_profiling : bool -> unit
+
+(* Cut off results < than specified cutoff *)
+val print_results : cutoff:float -> unit
+
+val print_results_tactic : string -> unit
+
+val reset_profile : unit -> unit
+
+val do_print_results_at_close : unit -> unit
+
+(* The collected statistics for a tactic. The timing data is collected over all
+ * instances of a given tactic from its parent. E.g. if tactic 'aaa' calls
+ * 'foo' twice, then 'aaa' will contain just one entry for 'foo' with the
+ * statistics of the two invocations combined, and also combined over all
+ * invocations of 'aaa'.
+ * total:     time spent running this tactic and its subtactics (seconds)
+ * local:      time spent running this tactic, minus its subtactics (seconds)
+ * ncalls: the number of invocations of this tactic that have been made
+ * max_total: the greatest running time of a single invocation (seconds)
+ *)
+type treenode = {
+  name : CString.Map.key;
+  total : float;
+  local : float;
+  ncalls : int;
+  max_total : float;
+  children : treenode CString.Map.t
+}
+
+(* Returns the profiling results known by the current process *)
+val get_local_profiling_results : unit -> treenode
+val feedback_results : treenode -> unit
+
diff --git a/ltac/profile_ltac_tactics.ml4 b/ltac/profile_ltac_tactics.ml4
new file mode 100644
index 000000000..8cb76d81c
--- /dev/null
+++ b/ltac/profile_ltac_tactics.ml4
@@ -0,0 +1,40 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+(*i camlp4deps: "grammar/grammar.cma" i*)
+
+(** Ltac profiling entrypoints *)
+
+open Profile_ltac
+open Stdarg
+
+DECLARE PLUGIN "profile_ltac_plugin"
+
+let tclSET_PROFILING b =
+   Proofview.tclLIFT (Proofview.NonLogical.make (fun () -> set_profiling b))
+
+TACTIC EXTEND start_ltac_profiling
+| [ "start" "ltac" "profiling" ] -> [ tclSET_PROFILING true ]
+END
+
+TACTIC EXTEND stop_profiling
+| [ "stop" "ltac" "profiling" ] -> [ tclSET_PROFILING false ]
+END
+
+VERNAC COMMAND EXTEND ResetLtacProfiling CLASSIFIED AS SIDEFF
+  [ "Reset" "Ltac" "Profile" ] -> [ reset_profile() ]
+END
+
+VERNAC COMMAND EXTEND ShowLtacProfile CLASSIFIED AS QUERY
+| [ "Show" "Ltac" "Profile" ] -> [ print_results ~cutoff:!Flags.profile_ltac_cutoff ]
+| [ "Show" "Ltac" "Profile" "CutOff" int(n) ] -> [ print_results ~cutoff:(float_of_int n) ]
+END
+
+VERNAC COMMAND EXTEND ShowLtacProfileTactic CLASSIFIED AS QUERY
+  [ "Show" "Ltac" "Profile" string(s) ] -> [ print_results_tactic s ]
+END
diff --git a/ltac/rewrite.ml b/ltac/rewrite.ml
index cb39df8ab..3c5a109c0 100644
--- a/ltac/rewrite.ml
+++ b/ltac/rewrite.ml
@@ -8,14 +8,14 @@
 
 open Names
 open Pp
-open Errors
+open CErrors
 open Util
 open Nameops
 open Namegen
 open Term
 open Vars
 open Reduction
-open Tacticals
+open Tacticals.New
 open Tacmach
 open Tactics
 open Pretype_errors
@@ -36,6 +36,9 @@ open Sigma.Notations
 open Proofview.Notations
 open Context.Named.Declaration
 
+module NamedDecl = Context.Named.Declaration
+module RelDecl = Context.Rel.Declaration
+
 (** Typeclass-based generalized rewriting. *)
 
 (** Constants used by the tactic. *)
@@ -218,7 +221,7 @@ end) = struct
       | Some (x, Some rel) -> evars, rel
     in
     let rec aux env evars ty l =
-      let t = Reductionops.whd_betadeltaiota env (goalevars evars) ty in
+      let t = Reductionops.whd_all env (goalevars evars) ty in
 	match kind_of_term t, l with
 	| Prod (na, ty, b), obj :: cstrs ->
           let b = Reductionops.nf_betaiota (goalevars evars) b in
@@ -321,7 +324,7 @@ end) = struct
     let rec aux evars env prod n = 
       if Int.equal n 0 then start evars env prod
       else
-	match kind_of_term (Reduction.whd_betadeltaiota env prod) with
+	match kind_of_term (Reduction.whd_all env prod) with
 	| Prod (na, ty, b) ->
 	  if noccurn 1 b then
 	    let b' = lift (-1) b in
@@ -339,7 +342,7 @@ end) = struct
 	try let evars, found = aux evars env ty (succ (List.length args)) in
 	      Some (evars, found, c, ty, arg :: args)
 	with Not_found ->
-	  let ty = whd_betadeltaiota env ty in
+	  let ty = whd_all env ty in
 	  find env (mkApp (c, [| arg |])) (prod_applist ty [arg]) args
     in find env c ty args
 
@@ -365,7 +368,7 @@ end) = struct
 	       rewrite_relation_class [| evar; mkApp (c, params) |] in
 	   let _ = Typeclasses.resolve_one_typeclass env' (goalevars evars) inst in
 	     Some (it_mkProd_or_LetIn t rels)
-	   with e when Errors.noncritical e -> None)
+	   with e when CErrors.noncritical e -> None)
   | _ -> None
 
 
@@ -438,15 +441,23 @@ let split_head = function
     hd :: tl -> hd, tl
   | [] -> assert(false)
 
+let eq_pb (ty, env, x, y as pb) (ty', env', x', y' as pb') =
+  pb == pb' || (ty == ty' && Constr.equal x x' && Constr.equal y y')
+
+let problem_inclusion x y =
+  List.for_all (fun pb -> List.exists (fun pb' -> eq_pb pb pb') y) x
+
 let evd_convertible env evd x y =
   try
-    let evd = Evarconv.the_conv_x env x y evd in
     (* Unfortunately, the_conv_x might say they are unifiable even if some
-        unsolvable constraints remain, so we check them here *)
-    let evd = Evarconv.consider_remaining_unif_problems env evd in
-    let () = Evarconv.check_problems_are_solved env evd in
-    Some evd
-  with e when Errors.noncritical e -> None
+       unsolvable constraints remain, so we check that this unification
+       does not introduce any new problem. *)
+    let _, pbs = Evd.extract_all_conv_pbs evd in
+    let evd' = Evarconv.the_conv_x env x y evd in
+    let _, pbs' = Evd.extract_all_conv_pbs evd' in
+    if evd' == evd || problem_inclusion pbs' pbs then Some evd'
+    else None
+  with e when CErrors.noncritical e -> None
 
 let convertible env evd x y =
   Reductionops.is_conv_leq env evd x y
@@ -581,9 +592,9 @@ let general_rewrite_unif_flags () =
   let core_flags =
     { rewrite_core_unif_flags with
       Unification.modulo_conv_on_closed_terms = Some ts;
-      Unification.use_evars_eagerly_in_conv_on_closed_terms = false;
+      Unification.use_evars_eagerly_in_conv_on_closed_terms = true;
       Unification.modulo_delta = ts;
-      Unification.modulo_delta_types = ts;
+      Unification.modulo_delta_types = full_transparent_state;
       Unification.modulo_betaiota = true }
   in {
     Unification.core_unify_flags = core_flags;
@@ -617,7 +628,7 @@ let solve_remaining_by env sigma holes by =
     | Genarg.GenArg (Genarg.Glbwit tag, tac) ->
       Ftactic.run (Geninterp.interp tag ist tac) (fun _ -> Proofview.tclUNIT ())
     in
-    let solve_tac = Tacticals.New.tclCOMPLETE solve_tac in
+    let solve_tac = tclCOMPLETE solve_tac in
     let solve sigma evk =
       let evi =
         try Some (Evd.find_undefined sigma evk)
@@ -1407,7 +1418,7 @@ module Strategies =
 	let sigma, c = Pretyping.understand_tcc env (goalevars evars) c in
 	let unfolded =
 	  try Tacred.try_red_product env sigma c
-	  with e when Errors.noncritical e ->
+	  with e when CErrors.noncritical e ->
             error "fold: the term is not unfoldable !"
 	in
 	  try
@@ -1416,7 +1427,7 @@ module Strategies =
 	      state, Success { rew_car = ty; rew_from = t; rew_to = c';
 				  rew_prf = RewCast DEFAULTcast;
 				  rew_evars = (sigma, snd evars) }
-	  with e when Errors.noncritical e -> state, Fail
+	  with e when CErrors.noncritical e -> state, Fail
 					 }
   
 
@@ -1432,17 +1443,8 @@ let rewrite_with l2r flags c occs : strategy = { strategy =
   fun ({ state = () } as input) ->
     let unify env evars t =
       let (sigma, cstrs) = evars in
-      let ans =
-        try Some (refresh_hypinfo env sigma c)
-        with e when Class_tactics.catchable e -> None
-      in
-      match ans with
-      | None -> None
-      | Some (sigma, rew) ->
-        let rew = unify_eqn rew l2r flags env (sigma, cstrs) None t in
-        match rew with
-        | None -> None
-        | Some rew -> Some rew
+      let (sigma, rew) = refresh_hypinfo env sigma c in
+      unify_eqn rew l2r flags env (sigma, cstrs) None t
     in
     let app = apply_rule unify occs in
     let strat = 
@@ -1466,7 +1468,7 @@ let solve_constraints env (evars,cstrs) =
       (Typeclasses.mark_resolvables ~filter evars)
       
 let nf_zeta =
-  Reductionops.clos_norm_flags (Closure.RedFlags.mkflags [Closure.RedFlags.fZETA])
+  Reductionops.clos_norm_flags (CClosure.RedFlags.mkflags [CClosure.RedFlags.fZETA])
 
 exception RewriteFailure of Pp.std_ppcmds
 
@@ -1500,7 +1502,7 @@ let cl_rewrite_clause_aux ?(abs=None) strat env avoid sigma concl is_hyp : resul
 	Evar.Set.fold 
 	  (fun ev acc -> 
 	   if not (Evd.is_defined acc ev) then 
-	     errorlabstrm "rewrite"
+	     user_err ~hdr:"rewrite"
 			  (str "Unsolved constraint remaining: " ++ spc () ++
 			   Evd.pr_evar_info (Evd.find acc ev))
 	   else Evd.remove acc ev) 
@@ -1528,7 +1530,7 @@ let cl_rewrite_clause_aux ?(abs=None) strat env avoid sigma concl is_hyp : resul
 let rec insert_dependent env decl accu hyps = match hyps with
 | [] -> List.rev_append accu [decl]
 | ndecl :: rem ->
-  if occur_var_in_decl env (get_id ndecl) decl then
+  if occur_var_in_decl env (NamedDecl.get_id ndecl) decl then
     List.rev_append accu (decl :: hyps)
   else
     insert_dependent env decl (ndecl :: accu) rem
@@ -1538,17 +1540,17 @@ let assert_replacing id newt tac =
     let concl = Proofview.Goal.concl gl in
     let env = Proofview.Goal.env gl in
     let ctx = Environ.named_context env in
-    let after, before = List.split_when (Id.equal id % get_id) ctx in
+    let after, before = List.split_when (NamedDecl.get_id %> Id.equal id) ctx in
     let nc = match before with
     | [] -> assert false
-    | d :: rem -> insert_dependent env (LocalAssum (get_id d, newt)) [] after @ rem
+    | d :: rem -> insert_dependent env (LocalAssum (NamedDecl.get_id d, newt)) [] after @ rem
     in
     let env' = Environ.reset_with_named_context (val_of_named_context nc) env in
     Refine.refine ~unsafe:false { run = begin fun sigma ->
       let Sigma (ev, sigma, p) = Evarutil.new_evar env' sigma concl in
       let Sigma (ev', sigma, q) = Evarutil.new_evar env sigma newt in
       let map d =
-        let n = get_id d in
+        let n = NamedDecl.get_id d in
         if Id.equal n id then ev' else mkVar n
       in
       let (e, _) = destEvar ev in
@@ -1562,6 +1564,10 @@ let newfail n s =
 
 let cl_rewrite_clause_newtac ?abs ?origsigma ~progress strat clause =
   let open Proofview.Notations in
+  (** For compatibility *)
+  let beta_red _ sigma c = Reductionops.nf_betaiota sigma c in
+  let beta = Tactics.reduct_in_concl (beta_red, DEFAULTcast) in
+  let beta_hyp id = Tactics.reduct_in_hyp beta_red (id, InHyp) in
   let treat sigma res = 
     match res with
     | None -> newfail 0 (str "Nothing to rewrite")
@@ -1573,12 +1579,16 @@ let cl_rewrite_clause_newtac ?abs ?origsigma ~progress strat clause =
         let gls = List.rev (Evd.fold_undefined fold undef []) in
 	match clause, prf with
 	| Some id, Some p ->
-            let tac = Refine.refine ~unsafe:false { run = fun h -> Sigma (p, h, Sigma.refl) } <*> Proofview.Unsafe.tclNEWGOALS gls in
+            let tac = tclTHENLIST [
+              Refine.refine ~unsafe:false { run = fun h -> Sigma.here p h };
+              Proofview.Unsafe.tclNEWGOALS gls;
+            ] in
             Proofview.Unsafe.tclEVARS undef <*>
-	    assert_replacing id newt tac
+	    tclTHENFIRST (assert_replacing id newt tac) (beta_hyp id)
 	| Some id, None ->
             Proofview.Unsafe.tclEVARS undef <*>
-            convert_hyp_no_check (LocalAssum (id, newt))
+            convert_hyp_no_check (LocalAssum (id, newt)) <*>
+            beta_hyp id
 	| None, Some p ->
             Proofview.Unsafe.tclEVARS undef <*>
             Proofview.Goal.enter { enter = begin fun gl ->
@@ -1593,12 +1603,6 @@ let cl_rewrite_clause_newtac ?abs ?origsigma ~progress strat clause =
             Proofview.Unsafe.tclEVARS undef <*>
             convert_concl_no_check newt DEFAULTcast
   in
-  let beta_red _ sigma c = Reductionops.nf_betaiota sigma c in
-  let beta = Tactics.reduct_in_concl (beta_red, DEFAULTcast) in
-  let opt_beta = match clause with
-  | None -> Proofview.tclUNIT ()
-  | Some id -> Tactics.reduct_in_hyp beta_red (id, InHyp)
-  in
   Proofview.Goal.nf_enter { enter = begin fun gl ->
     let concl = Proofview.Goal.concl gl in
     let env = Proofview.Goal.env gl in
@@ -1623,30 +1627,32 @@ let cl_rewrite_clause_newtac ?abs ?origsigma ~progress strat clause =
       let sigma = match origsigma with None -> sigma | Some sigma -> sigma in
       treat sigma res <*>
       (** For compatibility *)
-      beta <*> opt_beta <*> Proofview.shelve_unifiable
+      beta <*> Proofview.shelve_unifiable
     with
     | PretypeError (env, evd, (UnsatisfiableConstraints _ as e)) ->
       raise (RewriteFailure (Himsg.explain_pretype_error env evd e))
   end }
 
 let tactic_init_setoid () = 
-  try init_setoid (); tclIDTAC
-  with e when Errors.noncritical e -> tclFAIL 0 (str"Setoid library not loaded")
+  try init_setoid (); Proofview.tclUNIT ()
+  with e when CErrors.noncritical e -> Tacticals.New.tclFAIL 0 (str"Setoid library not loaded")
 
 let cl_rewrite_clause_strat progress strat clause =
-  tclTHEN (tactic_init_setoid ())
-  ((if progress then tclWEAK_PROGRESS else fun x -> x)
-   (fun gl -> 
-    try Proofview.V82.of_tactic (cl_rewrite_clause_newtac ~progress strat clause) gl
-    with RewriteFailure e ->
-	 errorlabstrm "" (str"setoid rewrite failed: " ++ e)
+  tactic_init_setoid () <*>
+  (if progress then Proofview.tclPROGRESS else fun x -> x)
+   (Proofview.tclOR
+      (cl_rewrite_clause_newtac ~progress strat clause)
+      (fun (e, info) -> match e with
+       | RewriteFailure e ->
+	 tclZEROMSG (str"setoid rewrite failed: " ++ e)
        | Refiner.FailError (n, pp) -> 
-	  tclFAIL n (str"setoid rewrite failed: " ++ Lazy.force pp) gl))
+	  tclFAIL n (str"setoid rewrite failed: " ++ Lazy.force pp)
+       | e -> Proofview.tclZERO ~info e))
 
 (** Setoid rewriting when called with "setoid_rewrite" *)
-let cl_rewrite_clause l left2right occs clause gl =
+let cl_rewrite_clause l left2right occs clause =
   let strat = rewrite_with left2right (general_rewrite_unif_flags ()) l occs in
-    cl_rewrite_clause_strat true strat clause gl
+    cl_rewrite_clause_strat true strat clause
 
 (** Setoid rewriting when called with "rewrite_strat" *)
 let cl_rewrite_clause_strat strat clause =
@@ -1697,6 +1703,40 @@ let rec map_strategy (f : 'a -> 'a2) (g : 'b -> 'b2) : ('a,'b) strategy_ast -> (
   | StratEval r -> StratEval (g r)
   | StratFold c -> StratFold (f c)
 
+let pr_ustrategy = function
+| Subterms -> str "subterms"
+| Subterm -> str "subterm"
+| Innermost -> str "innermost"
+| Outermost -> str "outermost"
+| Bottomup -> str "bottomup"
+| Topdown -> str "topdown"
+| Progress -> str "progress"
+| Try -> str "try"
+| Any -> str "any"
+| Repeat -> str "repeat"
+
+let paren p = str "(" ++ p ++ str ")"
+
+let rec pr_strategy prc prr = function
+| StratId -> str "id"
+| StratFail -> str "fail"
+| StratRefl -> str "refl"
+| StratUnary (s, str) ->
+  pr_ustrategy s ++ spc () ++ paren (pr_strategy prc prr str)
+| StratBinary (Choice, str1, str2) ->
+  str "choice" ++ spc () ++ paren (pr_strategy prc prr str1) ++ spc () ++
+    paren (pr_strategy prc prr str2)
+| StratBinary (Compose, str1, str2) ->
+  pr_strategy prc prr str1 ++ str ";" ++ spc () ++ pr_strategy prc prr str2
+| StratConstr (c, true) -> prc c
+| StratConstr (c, false) -> str "<-" ++ spc () ++ prc c
+| StratTerms cl -> str "terms" ++ spc () ++ pr_sequence prc cl
+| StratHints (old, id) ->
+  let cmd = if old then "old_hints" else "hints" in
+  str cmd ++ spc () ++ str id
+| StratEval r -> str "eval" ++ spc () ++ prr r
+| StratFold c -> str "fold" ++ spc () ++ prc c
+
 let rec strategy_of_ast = function
   | StratId -> Strategies.id
   | StratFail -> Strategies.fail
@@ -1751,7 +1791,7 @@ let declare_instance a aeq n s = declare_an_instance n s [a;aeq]
 let anew_instance global binders instance fields =
   new_instance (Flags.is_universe_polymorphism ()) 
     binders instance (Some (true, CRecord (Loc.ghost,fields)))
-    ~global ~generalize:false ~refine:false None
+    ~global ~generalize:false ~refine:false Hints.empty_hint_info
 
 let declare_instance_refl global binders a aeq n lemma =
   let instance = declare_instance a aeq (add_suffix n "_Reflexive") "Coq.Classes.RelationClasses.Reflexive"
@@ -1932,7 +1972,7 @@ let add_morphism_infer glob m n =
 				 Decl_kinds.IsAssumption Decl_kinds.Logical)
       in
 	add_instance (Typeclasses.new_instance 
-			(Lazy.force PropGlobal.proper_class) None glob 
+			(Lazy.force PropGlobal.proper_class) Hints.empty_hint_info glob
 			poly (ConstRef cst));
 	declare_projection n instance_id (ConstRef cst)
     else
@@ -1943,7 +1983,7 @@ let add_morphism_infer glob m n =
       let hook _ = function
 	| Globnames.ConstRef cst ->
 	  add_instance (Typeclasses.new_instance 
-			  (Lazy.force PropGlobal.proper_class) None
+			  (Lazy.force PropGlobal.proper_class) Hints.empty_hint_info
 			  glob poly (ConstRef cst));
 	  declare_projection n instance_id (ConstRef cst)
 	| _ -> assert false
@@ -1967,7 +2007,7 @@ let add_morphism glob binders m s n =
   let tac = Tacinterp.interp (make_tactic "add_morphism_tactic") in
     ignore(new_instance ~global:glob poly binders instance 
 	     (Some (true, CRecord (Loc.ghost,[])))
-	      ~generalize:false ~tac ~hook:(declare_projection n instance_id) None)
+	      ~generalize:false ~tac ~hook:(declare_projection n instance_id) Hints.empty_hint_info)
 
 (** Bind to "rewrite" too *)
 
@@ -2026,12 +2066,12 @@ let unification_rewrite l2r c1 c2 sigma prf car rel but env =
   abs, sigma, res, Sorts.is_prop sort
 
 let get_hyp gl (c,l) clause l2r =
-  let evars = project gl in
-  let env = pf_env gl in
+  let evars = Tacmach.New.project gl in
+  let env = Tacmach.New.pf_env gl in
   let sigma, hi = decompose_applied_relation env evars (c,l) in
   let but = match clause with
-    | Some id -> pf_get_hyp_typ gl id 
-    | None -> Evarutil.nf_evar evars (pf_concl gl)
+    | Some id -> Tacmach.New.pf_get_hyp_typ id gl
+    | None -> Evarutil.nf_evar evars (Tacmach.New.pf_concl gl)
   in
   unification_rewrite l2r hi.c1 hi.c2 sigma hi.prf hi.car hi.rel but env
 
@@ -2041,7 +2081,8 @@ let general_rewrite_flags = { under_lambdas = false; on_morphisms = true }
 (* let cl_rewrite_clause_tac = Profile.profile5 rewriteclaustac_key cl_rewrite_clause_tac *)
 
 (** Setoid rewriting when called with "rewrite" *)
-let general_s_rewrite cl l2r occs (c,l) ~new_goals gl =
+let general_s_rewrite cl l2r occs (c,l) ~new_goals =
+  Proofview.Goal.nf_enter { enter = begin fun gl ->
   let abs, evd, res, sort = get_hyp gl (c,l) cl l2r in
   let unify env evars t = unify_abs res l2r sort env evars t in
   let app = apply_rule unify occs in
@@ -2052,31 +2093,25 @@ let general_s_rewrite cl l2r occs (c,l) ~new_goals gl =
     (), res
 	      }
   in
-  let origsigma = project gl in
-  init_setoid ();
-    try
-      tclWEAK_PROGRESS 
+  let origsigma = Tacmach.New.project gl in
+  tactic_init_setoid () <*>
+    Proofview.tclOR
+      (tclPROGRESS
 	(tclTHEN
-           (Refiner.tclEVARS evd)
-	   (Proofview.V82.of_tactic
-	    (cl_rewrite_clause_newtac ~progress:true ~abs:(Some abs) ~origsigma strat cl))) gl
-    with RewriteFailure e ->
-      tclFAIL 0 (str"setoid rewrite failed: " ++ e) gl
-
-let general_s_rewrite_clause x =
-  match x with
-    | None -> general_s_rewrite None
-    | Some id -> general_s_rewrite (Some id)
-
-let general_s_rewrite_clause x y z w ~new_goals =
-  Proofview.V82.tactic (general_s_rewrite_clause x y z w ~new_goals)
+           (Proofview.Unsafe.tclEVARS evd)
+	    (cl_rewrite_clause_newtac ~progress:true ~abs:(Some abs) ~origsigma strat cl)))
+    (fun (e, info) -> match e with
+    | RewriteFailure e ->
+      tclFAIL 0 (str"setoid rewrite failed: " ++ e)
+    | e -> Proofview.tclZERO ~info e)
+  end }
 
-let _ = Hook.set Equality.general_setoid_rewrite_clause general_s_rewrite_clause
+let _ = Hook.set Equality.general_setoid_rewrite_clause general_s_rewrite
 
 (** [setoid_]{reflexivity,symmetry,transitivity} tactics *)
 
 let not_declared env ty rel =
-  Tacticals.New.tclFAIL 0
+  tclFAIL 0
     (str" The relation " ++ Printer.pr_constr_env env Evd.empty rel ++ str" is not a declared " ++
      str ty ++ str" relation. Maybe you need to require the Coq.Classes.RelationClasses library")
 
@@ -2089,9 +2124,8 @@ let setoid_proof ty fn fallback =
       begin
         try
           let rel, _, _ = decompose_app_rel env sigma concl in
-          let open Context.Rel.Declaration in
           let (sigma, t) = Typing.type_of env sigma rel in
-          let car = get_type (List.hd (fst (Reduction.dest_prod env t))) in
+          let car = RelDecl.get_type (List.hd (fst (Reduction.dest_prod env t))) in
 	    (try init_relation_classes () with _ -> raise Not_found);
             fn env sigma car rel
         with e -> Proofview.tclZERO e
@@ -2114,8 +2148,7 @@ let setoid_proof ty fn fallback =
   end }
 
 let tac_open ((evm,_), c) tac = 
-  Proofview.V82.tactic 
-    (tclTHEN (Refiner.tclEVARS evm) (tac c))
+    (tclTHEN (Proofview.Unsafe.tclEVARS evm) (tac c))
 
 let poly_proof getp gett env evm car rel =
   if Sorts.is_prop (sort_of_rel env evm rel) then
@@ -2128,7 +2161,7 @@ let setoid_reflexivity =
      tac_open (poly_proof PropGlobal.get_reflexive_proof
 			  TypeGlobal.get_reflexive_proof
 			  env evm car rel)
-	      (fun c -> tclCOMPLETE (Proofview.V82.of_tactic (apply c))))
+	      (fun c -> tclCOMPLETE (apply c)))
     (reflexivity_red true)
 
 let setoid_symmetry =
@@ -2137,7 +2170,7 @@ let setoid_symmetry =
       tac_open
 	(poly_proof PropGlobal.get_symmetric_proof TypeGlobal.get_symmetric_proof
 	   env evm car rel)
-	(fun c -> Proofview.V82.of_tactic (apply c)))
+	(fun c -> apply c))
     (symmetry_red true)
     
 let setoid_transitivity c =
@@ -2146,8 +2179,8 @@ let setoid_transitivity c =
       tac_open (poly_proof PropGlobal.get_transitive_proof TypeGlobal.get_transitive_proof
 	   env evm car rel)
 	(fun proof -> match c with
-	| None -> Proofview.V82.of_tactic (eapply proof)
-	| Some c -> Proofview.V82.of_tactic (apply_with_bindings (proof,ImplicitBindings [ c ]))))
+	| None -> eapply proof
+	| Some c -> apply_with_bindings (proof,ImplicitBindings [ c ])))
     (transitivity_red true c)
     
 let setoid_symmetry_in id =
@@ -2165,9 +2198,9 @@ let setoid_symmetry_in id =
   let new_hyp' =  mkApp (he, [| c2 ; c1 |]) in
   let new_hyp = it_mkProd_or_LetIn new_hyp'  binders in
    Proofview.V82.of_tactic
-    (Tacticals.New.tclTHENLAST
+    (tclTHENLAST
       (Tactics.assert_after_replacing id new_hyp)
-      (Tacticals.New.tclTHENLIST [ intros; setoid_symmetry; apply (mkVar id); Tactics.assumption ]))
+      (tclTHENLIST [ intros; setoid_symmetry; apply (mkVar id); Tactics.assumption ]))
       gl)
 
 let _ = Hook.set Tactics.setoid_reflexivity setoid_reflexivity
diff --git a/ltac/rewrite.mli b/ltac/rewrite.mli
index 01709f29f..35c448351 100644
--- a/ltac/rewrite.mli
+++ b/ltac/rewrite.mli
@@ -62,13 +62,16 @@ val strategy_of_ast : (glob_constr_and_expr, raw_red_expr) strategy_ast -> strat
 val map_strategy : ('a -> 'b) -> ('c -> 'd) ->
   ('a, 'c) strategy_ast -> ('b, 'd) strategy_ast
 
+val pr_strategy : ('a -> Pp.std_ppcmds) -> ('b -> Pp.std_ppcmds) ->
+  ('a, 'b) strategy_ast -> Pp.std_ppcmds
+
 (** Entry point for user-level "rewrite_strat" *)
-val cl_rewrite_clause_strat : strategy -> Id.t option -> tactic
+val cl_rewrite_clause_strat : strategy -> Id.t option -> unit Proofview.tactic
 
 (** Entry point for user-level "setoid_rewrite" *)
 val cl_rewrite_clause :
   interp_sign * (glob_constr_and_expr * glob_constr_and_expr bindings) ->
-  bool -> Locus.occurrences -> Id.t option -> tactic
+  bool -> Locus.occurrences -> Id.t option -> unit Proofview.tactic
 
 val is_applied_rewrite_relation :
   env -> evar_map -> Context.Rel.t -> constr -> types option
diff --git a/ltac/tacarg.ml b/ltac/tacarg.ml
new file mode 100644
index 000000000..42552c484
--- /dev/null
+++ b/ltac/tacarg.ml
@@ -0,0 +1,26 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+(** Generic arguments based on Ltac. *)
+
+open Genarg
+open Geninterp
+open Tacexpr
+
+let make0 ?dyn name =
+  let wit = Genarg.make0 name in
+  let () = Geninterp.register_val0 wit dyn in
+  wit
+
+let wit_tactic : (raw_tactic_expr, glob_tactic_expr, Val.t) genarg_type =
+  make0 "tactic"
+
+let wit_ltac = make0 ~dyn:(val_tag (topwit Stdarg.wit_unit)) "ltac"
+
+let wit_destruction_arg =
+  make0 "destruction_arg"
diff --git a/ltac/tacarg.mli b/ltac/tacarg.mli
new file mode 100644
index 000000000..bfa423db2
--- /dev/null
+++ b/ltac/tacarg.mli
@@ -0,0 +1,27 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+open Genarg
+open Tacexpr
+open Constrexpr
+open Misctypes
+
+(** Generic arguments based on Ltac. *)
+
+val wit_tactic : (raw_tactic_expr, glob_tactic_expr, Geninterp.Val.t) genarg_type
+
+(** [wit_ltac] is subtly different from [wit_tactic]: they only change for their
+    toplevel interpretation. The one of [wit_ltac] forces the tactic and
+    discards the result. *)
+val wit_ltac : (raw_tactic_expr, glob_tactic_expr, unit) genarg_type
+
+val wit_destruction_arg :
+  (constr_expr with_bindings Tacexpr.destruction_arg,
+   glob_constr_and_expr with_bindings Tacexpr.destruction_arg,
+   delayed_open_constr_with_bindings Tacexpr.destruction_arg) genarg_type
+
diff --git a/tactics/taccoerce.ml b/ltac/taccoerce.ml
index d53c1cc04..df38a42cb 100644
--- a/tactics/taccoerce.ml
+++ b/ltac/taccoerce.ml
@@ -13,7 +13,6 @@ open Pattern
 open Misctypes
 open Genarg
 open Stdarg
-open Constrarg
 open Geninterp
 
 exception CannotCoerceTo of string
@@ -107,7 +106,7 @@ let coerce_to_constr_context v =
   else raise (CannotCoerceTo "a term context")
 
 (* Interprets an identifier which must be fresh *)
-let coerce_to_ident fresh env v =
+let coerce_var_to_ident fresh env v =
   let v = Value.normalize v in
   let fail () = raise (CannotCoerceTo "a fresh identifier") in
   if has_type v (topwit wit_intro_pattern) then
@@ -124,6 +123,52 @@ let coerce_to_ident fresh env v =
       destVar c
     else fail ()
 
+
+(* Interprets, if possible, a constr to an identifier which may not
+   be fresh but suitable to be given to the fresh tactic. Works for
+   vars, constants, inductive, constructors and sorts. *)
+let coerce_to_ident_not_fresh g env v =
+let id_of_name = function
+  | Names.Anonymous -> Id.of_string "x"
+  | Names.Name x -> x in
+  let v = Value.normalize v in
+  let fail () = raise (CannotCoerceTo "an identifier") in
+  if has_type v (topwit wit_intro_pattern) then
+    match out_gen (topwit wit_intro_pattern) v with
+    | _, IntroNaming (IntroIdentifier id) -> id
+    | _ -> fail ()
+  else if has_type v (topwit wit_var) then
+    out_gen (topwit wit_var) v
+  else
+    match Value.to_constr v with
+    | None -> fail ()
+    | Some c ->
+       match Constr.kind c with
+       | Var id -> id 
+       | Meta m -> id_of_name (Evd.meta_name g m)
+       | Evar (kn,_) ->
+        begin match Evd.evar_ident kn g with
+        | None -> fail ()
+        | Some id -> id
+        end
+       | Const (cst,_) -> Label.to_id (Constant.label cst)
+       | Construct (cstr,_) ->
+	  let ref = Globnames.ConstructRef cstr in
+	  let basename = Nametab.basename_of_global ref in
+	  basename
+       | Ind (ind,_) ->
+	  let ref = Globnames.IndRef ind in
+	  let basename = Nametab.basename_of_global ref in
+	  basename
+       | Sort s ->
+	  begin
+	    match s with
+	    | Prop _ -> Label.to_id (Label.make "Prop")
+	    | Type _ -> Label.to_id (Label.make "Type")
+	  end
+       | _ -> fail()
+
+
 let coerce_to_intro_pattern env v =
   let v = Value.normalize v in
   if has_type v (topwit wit_intro_pattern) then
@@ -190,6 +235,7 @@ let coerce_to_closed_constr env v =
 let coerce_to_evaluable_ref env v =
   let fail () = raise (CannotCoerceTo "an evaluable reference") in
   let v = Value.normalize v in
+  let ev =
   if has_type v (topwit wit_intro_pattern) then
     match out_gen (topwit wit_intro_pattern) v with
     | _, IntroNaming (IntroIdentifier id) when is_variable env id -> EvalVarRef id
@@ -206,12 +252,11 @@ let coerce_to_evaluable_ref env v =
     | ConstRef c -> EvalConstRef c
     | IndRef _ | ConstructRef _ -> fail ()
   else
-    let ev = match Value.to_constr v with
+    match Value.to_constr v with
     | Some c when isConst c -> EvalConstRef (Univ.out_punivs (destConst c))
     | Some c when isVar c -> EvalVarRef (destVar c)
     | _ -> fail ()
-    in
-    if Tacred.is_evaluable env ev then ev else fail ()
+  in if Tacred.is_evaluable env ev then ev else fail ()
 
 let coerce_to_constr_list env v =
   let v = Value.to_list v in
diff --git a/tactics/taccoerce.mli b/ltac/taccoerce.mli
index 7a963f95f..0b67f8726 100644
--- a/tactics/taccoerce.mli
+++ b/ltac/taccoerce.mli
@@ -50,7 +50,9 @@ end
 
 val coerce_to_constr_context : Value.t -> constr
 
-val coerce_to_ident : bool -> Environ.env -> Value.t -> Id.t
+val coerce_var_to_ident : bool -> Environ.env -> Value.t -> Id.t
+
+val coerce_to_ident_not_fresh : Evd.evar_map -> Environ.env -> Value.t -> Id.t
 
 val coerce_to_intro_pattern : Environ.env -> Value.t -> Tacexpr.delayed_open_constr intro_pattern_expr
 
diff --git a/ltac/tacentries.ml b/ltac/tacentries.ml
index 1d9e7b34e..2e2b55be7 100644
--- a/ltac/tacentries.ml
+++ b/ltac/tacentries.ml
@@ -7,7 +7,7 @@
 (************************************************************************)
 
 open Pp
-open Errors
+open CErrors
 open Util
 open Names
 open Libobject
@@ -43,8 +43,8 @@ let coincide s pat off =
   !break
 
 let atactic n =
-  if n = 5 then Aentry Tactic.binder_tactic
-  else Aentryl (Tactic.tactic_expr, n)
+  if n = 5 then Aentry Pltac.binder_tactic
+  else Aentryl (Pltac.tactic_expr, n)
 
 type entry_name = EntryName :
   'a raw_abstract_argument_type * (Tacexpr.raw_tactic_expr, 'a) Extend.symbol -> entry_name
@@ -56,9 +56,9 @@ let get_tacentry n m =
     && not (Int.equal m 5) (* Because tactic5 is at binder_tactic *)
     && not (Int.equal m 0) (* Because tactic0 is at simple_tactic *)
   in
-  if check_lvl n then EntryName (rawwit Constrarg.wit_tactic, Aself)
-  else if check_lvl (n + 1) then EntryName (rawwit Constrarg.wit_tactic, Anext)
-  else EntryName (rawwit Constrarg.wit_tactic, atactic n)
+  if check_lvl n then EntryName (rawwit Tacarg.wit_tactic, Aself)
+  else if check_lvl (n + 1) then EntryName (rawwit Tacarg.wit_tactic, Anext)
+  else EntryName (rawwit Tacarg.wit_tactic, atactic n)
 
 let get_separator = function
 | None -> error "Missing separator."
@@ -108,11 +108,11 @@ let interp_entry_name interp symb =
 
 let get_tactic_entry n =
   if Int.equal n 0 then
-    Tactic.simple_tactic, None
+    Pltac.simple_tactic, None
   else if Int.equal n 5 then
-    Tactic.binder_tactic, None
+    Pltac.binder_tactic, None
   else if 1<=n && n<5 then
-    Tactic.tactic_expr, Some (Extend.Level (string_of_int n))
+    Pltac.tactic_expr, Some (Extend.Level (string_of_int n))
   else
     error ("Invalid Tactic Notation level: "^(string_of_int n)^".")
 
@@ -163,7 +163,7 @@ let add_tactic_entry (kn, ml, tg) state =
   let mkact loc l =
     let map arg =
       (** HACK to handle especially the tactic(...) entry *)
-      let wit = Genarg.rawwit Constrarg.wit_tactic in
+      let wit = Genarg.rawwit Tacarg.wit_tactic in
       if Genarg.has_type arg wit && not ml then
         Tacexp (Genarg.out_gen wit arg)
       else
@@ -218,7 +218,7 @@ let interp_prod_item = function
     | Some n ->
       (** FIXME: do better someday *)
       assert (String.equal s "tactic");
-      begin match Constrarg.wit_tactic with
+      begin match Tacarg.wit_tactic with
       | ExtraArg tag -> ArgT.Any tag
       | _ -> assert false
       end
@@ -405,7 +405,7 @@ let create_ltac_quotation name cast (e, l) =
   in
   let action _ v _ _ _ loc = cast (loc, v) in
   let gram = (level, assoc, [Rule (rule, action)]) in
-  Pcoq.grammar_extend Tactic.tactic_arg None (None, [gram])
+  Pcoq.grammar_extend Pltac.tactic_arg None (None, [gram])
 
 (** Command *)
 
@@ -417,35 +417,37 @@ type tacdef_kind =
 let is_defined_tac kn =
   try ignore (Tacenv.interp_ltac kn); true with Not_found -> false
 
+let warn_unusable_identifier =
+  CWarnings.create ~name:"unusable-identifier" ~category:"parsing"
+      (fun id -> strbrk "The Ltac name" ++ spc () ++ pr_id id ++ spc () ++
+        strbrk "may be unusable because of a conflict with a notation.")
+
 let register_ltac local tacl =
   let map tactic_body =
     match tactic_body with
-    | TacticDefinition ((loc,id), body) ->
+    | Tacexpr.TacticDefinition ((loc,id), body) ->
         let kn = Lib.make_kn id in
         let id_pp = pr_id id in
         let () = if is_defined_tac kn then
-          Errors.user_err_loc (loc, "",
-            str "There is already an Ltac named " ++ id_pp ++ str".")
+          CErrors.user_err ~loc 
+            (str "There is already an Ltac named " ++ id_pp ++ str".")
         in
-        let is_primitive =
+        let is_shadowed =
           try
-            match Pcoq.parse_string Pcoq.Tactic.tactic (Id.to_string id) with
+            match Pcoq.parse_string Pltac.tactic (Id.to_string id) with
             | Tacexpr.TacArg _ -> false
             | _ -> true (* most probably TacAtom, i.e. a primitive tactic ident *)
-          with e when Errors.noncritical e -> true (* prim tactics with args, e.g. "apply" *)
-        in
-        let () = if is_primitive then
-          Feedback.msg_warning (str "The Ltac name " ++ id_pp ++
-            str " may be unusable because of a conflict with a notation.")
+          with e when CErrors.noncritical e -> true (* prim tactics with args, e.g. "apply" *)
         in
+        let () = if is_shadowed then warn_unusable_identifier id in
         NewTac id, body
-    | TacticRedefinition (ident, body) ->
+    | Tacexpr.TacticRedefinition (ident, body) ->
         let loc = loc_of_reference ident in
         let kn =
           try Nametab.locate_tactic (snd (qualid_of_reference ident))
           with Not_found ->
-            Errors.user_err_loc (loc, "",
-                        str "There is no Ltac named " ++ pr_reference ident ++ str ".")
+            CErrors.user_err ~loc 
+                       (str "There is no Ltac named " ++ pr_reference ident ++ str ".")
         in
         UpdateTac kn, body
   in
@@ -480,3 +482,44 @@ let register_ltac local tacl =
     Flags.if_verbose Feedback.msg_info (Libnames.pr_qualid name ++ str " is redefined")
   in
   List.iter iter defs
+
+(** Queries *)
+
+let print_ltacs () =
+  let entries = KNmap.bindings (Tacenv.ltac_entries ()) in
+  let sort (kn1, _) (kn2, _) = KerName.compare kn1 kn2 in
+  let entries = List.sort sort entries in
+  let map (kn, entry) =
+    let qid =
+      try Some (Nametab.shortest_qualid_of_tactic kn)
+      with Not_found -> None
+    in
+    match qid with
+    | None -> None
+    | Some qid -> Some (qid, entry.Tacenv.tac_body)
+  in
+  let entries = List.map_filter map entries in
+  let pr_entry (qid, body) =
+    let (l, t) = match body with
+    | Tacexpr.TacFun (l, t) -> (l, t)
+    | _ -> ([], body)
+    in
+    let pr_ltac_fun_arg = function
+    | None -> spc () ++ str "_"
+    | Some id -> spc () ++ pr_id id
+    in
+    hov 2 (pr_qualid qid ++ prlist pr_ltac_fun_arg l)
+  in
+  Feedback.msg_notice (prlist_with_sep fnl pr_entry entries)
+
+(** Grammar *)
+
+let () =
+  let open Metasyntax in
+  let entries = [
+    AnyEntry Pltac.tactic_expr;
+    AnyEntry Pltac.binder_tactic;
+    AnyEntry Pltac.simple_tactic;
+    AnyEntry Pltac.tactic_arg;
+  ] in
+  register_grammar "tactic" entries
diff --git a/ltac/tacentries.mli b/ltac/tacentries.mli
index 402cb2fc9..969c118fb 100644
--- a/ltac/tacentries.mli
+++ b/ltac/tacentries.mli
@@ -13,7 +13,7 @@ open Tacexpr
 
 (** {5 Tactic Definitions} *)
 
-val register_ltac : locality_flag -> Vernacexpr.tacdef_body list -> unit
+val register_ltac : locality_flag -> Tacexpr.tacdef_body list -> unit
 (** Adds new Ltac definitions to the environment. *)
 
 (** {5 Tactic Notations} *)
@@ -57,3 +57,8 @@ val create_ltac_quotation : string ->
 (** [create_ltac_quotation name f e] adds a quotation rule to Ltac, that is,
     Ltac grammar now accepts arguments of the form ["name" ":" "(" <e> ")"], and
     generates an argument using [f] on the entry parsed by [e]. *)
+
+(** {5 Queries} *)
+
+val print_ltacs : unit -> unit
+(** Display the list of ltac definitions currently available. *)
diff --git a/ltac/tacenv.ml b/ltac/tacenv.ml
index 005d1f5f4..e3c2b4ad5 100644
--- a/ltac/tacenv.ml
+++ b/ltac/tacenv.ml
@@ -24,7 +24,7 @@ let register_alias key tac =
 
 let interp_alias key =
   try KNmap.find key !alias_map
-  with Not_found -> Errors.anomaly (str "Unknown tactic alias: " ++ KerName.print key)
+  with Not_found -> CErrors.anomaly (str "Unknown tactic alias: " ++ KerName.print key)
 
 let check_alias key = KNmap.mem key !alias_map
 
@@ -53,10 +53,9 @@ let register_ml_tactic ?(overwrite = false) s (t : ml_tactic array) =
   let () =
     if MLTacMap.mem s !tac_tab then
       if overwrite then
-        let () = tac_tab := MLTacMap.remove s !tac_tab in
-        Feedback.msg_warning (str "Overwriting definition of tactic " ++ pr_tacname s)
+        tac_tab := MLTacMap.remove s !tac_tab
       else
-        Errors.anomaly (str "Cannot redeclare tactic " ++ pr_tacname s ++ str ".")
+        CErrors.anomaly (str "Cannot redeclare tactic " ++ pr_tacname s ++ str ".")
   in
   tac_tab := MLTacMap.add s t !tac_tab
 
@@ -66,7 +65,7 @@ let interp_ml_tactic { mltac_name = s; mltac_index = i } =
     let () = if Array.length tacs <= i then raise Not_found in
     tacs.(i)
   with Not_found ->
-    Errors.errorlabstrm ""
+    CErrors.user_err 
       (str "The tactic " ++ pr_tacname s ++ str " is not installed.")
 
 (***************************************************************************)
diff --git a/intf/tacexpr.mli b/ltac/tacexpr.mli
index e06436d8a..9c25a1645 100644
--- a/intf/tacexpr.mli
+++ b/ltac/tacexpr.mli
@@ -32,17 +32,21 @@ type advanced_flag = bool  (* true = advanced         false = basic *)
 type letin_flag = bool     (* true = use local def    false = use Leibniz *)
 type clear_flag = bool option (* true = clear hyp, false = keep hyp, None = use default *)
 
-type debug = Debug | Info | Off (* for trivial / auto / eauto ... *)
+type goal_selector = Vernacexpr.goal_selector =
+  | SelectNth of int
+  | SelectList of (int * int) list
+  | SelectId of Id.t
+  | SelectAll
 
-type 'a core_induction_arg =
+type 'a core_destruction_arg = 'a Misctypes.core_destruction_arg =
   | ElimOnConstr of 'a
   | ElimOnIdent of Id.t located
   | ElimOnAnonHyp of int
 
-type 'a induction_arg =
-  clear_flag * 'a core_induction_arg
+type 'a destruction_arg =
+  clear_flag * 'a core_destruction_arg
 
-type inversion_kind =
+type inversion_kind = Misctypes.inversion_kind =
   | SimpleInversion
   | FullInversion
   | FullInversionClear
@@ -62,7 +66,7 @@ type 'id message_token =
   | MsgIdent of 'id
 
 type ('dconstr,'id) induction_clause =
-    'dconstr with_bindings induction_arg *
+    'dconstr with_bindings destruction_arg *
     (intro_pattern_naming_expr located option (* eqn:... *)
     * 'dconstr or_and_intro_pattern_expr located or_var option) (* as ... *)
     * 'id clause_expr option (* in ... *)
@@ -73,12 +77,6 @@ type ('constr,'dconstr,'id) induction_clause_list =
 
 type 'a with_bindings_arg = clear_flag * 'a with_bindings
 
-type multi =
-  | Precisely of int
-  | UpTo of int
-  | RepeatStar
-  | RepeatPlus
-
 (* Type of patterns *)
 type 'a match_pattern =
   | Term of 'a
@@ -111,18 +109,15 @@ type ml_tactic_entry = {
 
 (** Composite types *)
 
-(** In globalize tactics, we need to keep the initial [constr_expr] to recompute
-   in the environment by the effective calls to Intro, Inversion, etc 
-   The [constr_expr] field is [None] in TacDef though *)
-type glob_constr_and_expr = Glob_term.glob_constr * constr_expr option
+type glob_constr_and_expr = Tactypes.glob_constr_and_expr
 
 type open_constr_expr = unit * constr_expr
 type open_glob_constr = unit * glob_constr_and_expr
 
-type binding_bound_vars = Id.Set.t
+type binding_bound_vars = Constr_matching.binding_bound_vars
 type glob_constr_pattern_and_expr = binding_bound_vars * glob_constr_and_expr * constr_pattern
 
-type 'a delayed_open = 'a Pretyping.delayed_open =
+type 'a delayed_open = 'a Tactypes.delayed_open =
   { delayed : 'r. Environ.env -> 'r Sigma.t -> ('a, 'r) Sigma.sigma }
 
 type delayed_open_constr_with_bindings = Term.constr with_bindings delayed_open
@@ -138,9 +133,7 @@ type intro_pattern_naming = intro_pattern_naming_expr located
 
 type 'a gen_atomic_tactic_expr =
   (* Basic tactics *)
-  | TacIntroPattern of 'dtrm intro_pattern_expr located list
-  | TacIntroMove of Id.t option * 'nam move_location
-  | TacExact of 'trm
+  | TacIntroPattern of evars_flag * 'dtrm intro_pattern_expr located list
   | TacApply of advanced_flag * evars_flag * 'trm with_bindings_arg list *
       ('nam * 'dtrm intro_pattern_expr located option) option
   | TacElim of evars_flag * 'trm with_bindings_arg * 'trm with_bindings option
@@ -148,7 +141,7 @@ type 'a gen_atomic_tactic_expr =
   | TacMutualFix of Id.t * int * (Id.t * int * 'trm) list
   | TacMutualCofix of Id.t * (Id.t * 'trm) list
   | TacAssert of
-      bool * 'tacexpr option *
+      bool * 'tacexpr option option *
       'dtrm intro_pattern_expr located option * 'trm
   | TacGeneralize of ('trm with_occurrences * Name.t) list
   | TacLetTac of Name.t * 'trm * 'nam clause_expr * letin_flag *
@@ -157,10 +150,6 @@ type 'a gen_atomic_tactic_expr =
   (* Derived basic tactics *)
   | TacInductionDestruct of
       rec_flag * evars_flag * ('trm,'dtrm,'nam) induction_clause_list
-  | TacDoubleInduction of quantified_hypothesis * quantified_hypothesis
-
-  (* Context management *)
-  | TacRename of ('nam *'nam) list
 
   (* Conversion *)
   | TacReduce of ('trm,'cst,'pat) red_expr_gen * 'nam clause_expr
@@ -275,6 +264,7 @@ and 'a gen_tactic_expr =
       ('p,'a gen_tactic_expr) match_rule list
   | TacFun of 'a gen_tactic_fun_ast
   | TacArg of 'a gen_tactic_arg located
+  | TacSelect of goal_selector * 'a gen_tactic_expr
   (* For ML extensions *)
   | TacML of Loc.t * ml_tactic_entry * 'a gen_tactic_arg list
   (* For syntax extensions *)
@@ -400,3 +390,7 @@ type ltac_call_kind =
   | LtacConstrInterp of Glob_term.glob_constr * Pretyping.ltac_var_map
 
 type ltac_trace = (Loc.t * ltac_call_kind) list
+
+type tacdef_body =
+  | TacticDefinition of Id.t Loc.located * raw_tactic_expr  (* indicates that user employed ':=' in Ltac body *)
+  | TacticRedefinition of reference * raw_tactic_expr       (* indicates that user employed '::=' in Ltac body *)
diff --git a/ltac/tacintern.ml b/ltac/tacintern.ml
index 3744449e9..763e0dc22 100644
--- a/ltac/tacintern.ml
+++ b/ltac/tacintern.ml
@@ -11,7 +11,7 @@ open Pp
 open Genredexpr
 open Glob_term
 open Tacred
-open Errors
+open CErrors
 open Util
 open Names
 open Nameops
@@ -23,7 +23,8 @@ open Constrexpr
 open Termops
 open Tacexpr
 open Genarg
-open Constrarg
+open Stdarg
+open Tacarg
 open Misctypes
 open Locus
 
@@ -32,11 +33,8 @@ open Locus
 
 let dloc = Loc.ghost
 
-let error_global_not_found_loc (loc,qid) =
-  error_global_not_found_loc loc qid
-
-let error_tactic_expected loc =
-  user_err_loc (loc,"",str "Tactic expected.")
+let error_tactic_expected ?loc =
+  user_err ?loc  (str "Tactic expected.")
 
 (** Generic arguments *)
 
@@ -85,7 +83,7 @@ let intern_hyp ist (loc,id as locid) =
   else if find_ident id ist then
     (dloc,id)
   else
-    Pretype_errors.error_var_not_found_loc loc id
+    Pretype_errors.error_var_not_found ~loc id
 
 let intern_or_var f ist = function
   | ArgVar locid -> ArgVar (intern_hyp ist locid)
@@ -99,7 +97,7 @@ let intern_global_reference ist = function
   | r ->
       let loc,_ as lqid = qualid_of_reference r in
       try ArgArg (loc,locate_global_with_alias lqid)
-      with Not_found -> error_global_not_found_loc lqid
+      with Not_found -> error_global_not_found (snd lqid)
 
 let intern_ltac_variable ist = function
   | Ident (loc,id) ->
@@ -143,7 +141,7 @@ let intern_isolated_tactic_reference strict ist r =
   try ConstrMayEval (ConstrTerm (intern_constr_reference strict ist r))
   with Not_found ->
   (* Reference not found *)
-  error_global_not_found_loc (qualid_of_reference r)
+  error_global_not_found (snd (qualid_of_reference r))
 
 (* Internalize an applied tactic reference *)
 
@@ -159,7 +157,7 @@ let intern_applied_tactic_reference ist r =
   try intern_applied_global_tactic_reference r
   with Not_found ->
   (* Reference not found *)
-  error_global_not_found_loc (qualid_of_reference r)
+  error_global_not_found (snd (qualid_of_reference r))
 
 (* Intern a reference parsed in a non-tactic entry *)
 
@@ -180,7 +178,7 @@ let intern_non_tactic_reference strict ist r =
     TacGeneric ipat
   | _ ->
   (* Reference not found *)
-  error_global_not_found_loc (qualid_of_reference r)
+  error_global_not_found (snd (qualid_of_reference r))
 
 let intern_message_token ist = function
   | (MsgString _ | MsgInt _ as x) -> x
@@ -269,7 +267,7 @@ let intern_intro_pattern_naming_loc lf ist (loc,pat) =
   (loc,intern_intro_pattern_naming lf ist pat)
 
   (* TODO: catch ltac vars *)
-let intern_induction_arg ist = function
+let intern_destruction_arg ist = function
   | clear,ElimOnConstr c -> clear,ElimOnConstr (intern_constr_with_bindings ist c)
   | clear,ElimOnAnonHyp n as x -> x
   | clear,ElimOnIdent (loc,id) ->
@@ -291,7 +289,7 @@ let intern_evaluable_global_reference ist r =
   with Not_found ->
   match r with
   | Ident (loc,id) when not !strict_check -> EvalVarRef id
-  | _ -> error_global_not_found_loc lqid
+  | _ -> error_global_not_found (snd lqid)
 
 let intern_evaluable_reference_or_by_notation ist = function
   | AN r -> intern_evaluable_global_reference ist r
@@ -378,13 +376,13 @@ let dump_glob_red_expr = function
     try
       Dumpglob.add_glob (loc_of_or_by_notation Libnames.loc_of_reference r)
 	(Smartlocate.smart_global r)
-    with e when Errors.noncritical e -> ()) occs
+    with e when CErrors.noncritical e -> ()) occs
   | Cbv grf | Lazy grf ->
     List.iter (fun r ->
       try
         Dumpglob.add_glob (loc_of_or_by_notation Libnames.loc_of_reference r)
 	  (Smartlocate.smart_global r)
-      with e when Errors.noncritical e -> ()) grf.rConst
+      with e when CErrors.noncritical e -> ()) grf.rConst
   | _ -> ()
 
 let intern_red_expr ist = function
@@ -424,7 +422,7 @@ let intern_hyp_location ist ((occs,id),hl) =
 (* Reads a pattern *)
 let intern_pattern ist ?(as_type=false) ltacvars = function
   | Subterm (b,ido,pc) ->
-      let (metas,pc) = intern_constr_pattern ist ~as_type ~ltacvars pc in
+      let (metas,pc) = intern_constr_pattern ist ~as_type:false ~ltacvars pc in
       ido, metas, Subterm (b,ido,pc)
   | Term pc ->
       let (metas,pc) = intern_constr_pattern ist ~as_type ~ltacvars pc in
@@ -446,7 +444,7 @@ let opt_cons accu = function
 | Some id -> Id.Set.add id accu
 
 (* Reads the hypotheses of a "match goal" rule *)
-let rec intern_match_goal_hyps ist lfun = function
+let rec intern_match_goal_hyps ist ?(as_type=false) lfun = function
   | (Hyp ((_,na) as locna,mp))::tl ->
       let ido, metas1, pat = intern_pattern ist ~as_type:true lfun mp in
       let lfun, metas2, hyps = intern_match_goal_hyps ist lfun tl in
@@ -455,7 +453,7 @@ let rec intern_match_goal_hyps ist lfun = function
   | (Def ((_,na) as locna,mv,mp))::tl ->
       let ido, metas1, patv = intern_pattern ist ~as_type:false lfun mv in
       let ido', metas2, patt = intern_pattern ist ~as_type:true lfun mp in
-      let lfun, metas3, hyps = intern_match_goal_hyps ist lfun tl in
+      let lfun, metas3, hyps = intern_match_goal_hyps ist ~as_type lfun tl in
       let lfun' = name_cons (opt_cons (opt_cons lfun ido) ido') na in
       lfun', metas1@metas2@metas3, Def (locna,patv,patt)::hyps
   | [] -> lfun, [], []
@@ -463,8 +461,8 @@ let rec intern_match_goal_hyps ist lfun = function
 (* Utilities *)
 let extract_let_names lrc =
   let fold accu ((loc, name), _) =
-    if Id.Set.mem name accu then user_err_loc
-      (loc, "glob_tactic", str "This variable is bound several times.")
+    if Id.Set.mem name accu then user_err ~loc
+      ~hdr:"glob_tactic" (str "This variable is bound several times.")
     else Id.Set.add name accu
   in
   List.fold_left fold Id.Set.empty lrc
@@ -479,12 +477,8 @@ let clause_app f = function
 let rec intern_atomic lf ist x =
   match (x:raw_atomic_tactic_expr) with
   (* Basic tactics *)
-  | TacIntroPattern l ->
-      TacIntroPattern (List.map (intern_intro_pattern lf ist) l)
-  | TacIntroMove (ido,hto) ->
-      TacIntroMove (Option.map (intern_ident lf ist) ido,
-                    intern_move_location ist hto)
-  | TacExact c -> TacExact (intern_constr ist c)
+  | TacIntroPattern (ev,l) ->
+      TacIntroPattern (ev,List.map (intern_intro_pattern lf ist) l)
   | TacApply (a,ev,cb,inhyp) ->
       TacApply (a,ev,List.map (intern_constr_with_bindings_arg ist) cb,
                 Option.map (intern_in_hyp_as ist lf) inhyp)
@@ -499,7 +493,7 @@ let rec intern_atomic lf ist x =
       let f (id,c) = (intern_ident lf ist id,intern_type ist c) in
       TacMutualCofix (intern_ident lf ist id, List.map f l)
   | TacAssert (b,otac,ipat,c) ->
-      TacAssert (b,Option.map (intern_pure_tactic ist) otac,
+      TacAssert (b,Option.map (Option.map (intern_pure_tactic ist)) otac,
                  Option.map (intern_intro_pattern lf ist) ipat,
                  intern_constr_gen false (not (Option.is_empty otac)) ist c)
   | TacGeneralize cl ->
@@ -515,21 +509,11 @@ let rec intern_atomic lf ist x =
   (* Derived basic tactics *)
   | TacInductionDestruct (ev,isrec,(l,el)) ->
       TacInductionDestruct (ev,isrec,(List.map (fun (c,(ipato,ipats),cls) ->
-	      (intern_induction_arg ist c,
+	      (intern_destruction_arg ist c,
                (Option.map (intern_intro_pattern_naming_loc lf ist) ipato,
                Option.map (intern_or_and_intro_pattern_loc lf ist) ipats),
                Option.map (clause_app (intern_hyp_location ist)) cls)) l,
                Option.map (intern_constr_with_bindings ist) el))
-  | TacDoubleInduction (h1,h2) ->
-      let h1 = intern_quantified_hypothesis ist h1 in
-      let h2 = intern_quantified_hypothesis ist h2 in
-      TacDoubleInduction (h1,h2)
-  (* Context management *)
-  | TacRename l ->
-      TacRename (List.map (fun (id1,id2) ->
-			     intern_hyp ist id1,
-			     intern_hyp ist id2) l)
-
   (* Conversion *)
   | TacReduce (r,cl) ->
       dump_glob_red_expr r;
@@ -578,7 +562,7 @@ and intern_tactic_seq onlytac ist = function
       ist.ltacvars, TacLetIn (isrec,l,intern_tactic onlytac ist' u)
 
   | TacMatchGoal (lz,lr,lmr) ->
-      ist.ltacvars, (TacMatchGoal(lz,lr, intern_match_rule onlytac ist lmr))
+      ist.ltacvars, TacMatchGoal(lz,lr, intern_match_rule onlytac ist ~as_type:true lmr)
   | TacMatch (lz,c,lmr) ->
       ist.ltacvars,
       TacMatch (lz,intern_tactic_or_tacarg ist c,intern_match_rule onlytac ist lmr)
@@ -638,6 +622,8 @@ and intern_tactic_seq onlytac ist = function
   | TacSolve l -> ist.ltacvars, TacSolve (List.map (intern_pure_tactic ist) l)
   | TacComplete tac -> ist.ltacvars, TacComplete (intern_pure_tactic ist tac)
   | TacArg (loc,a) -> ist.ltacvars, intern_tactic_as_arg loc onlytac ist a
+  | TacSelect (sel, tac) ->
+      ist.ltacvars, TacSelect (sel, intern_pure_tactic ist tac)
 
   (* For extensions *)
   | TacAlias (loc,s,l) ->
@@ -653,7 +639,7 @@ and intern_tactic_as_arg loc onlytac ist a =
   | TacGeneric _ as a -> TacArg (loc,a)
   | Tacexp a -> a
   | ConstrMayEval _ | TacFreshId _ | TacPretype _ | TacNumgoals as a ->
-      if onlytac then error_tactic_expected loc else TacArg (loc,a)
+      if onlytac then error_tactic_expected ~loc else TacArg (loc,a)
 
 and intern_tactic_or_tacarg ist = intern_tactic false ist
 
@@ -680,18 +666,18 @@ and intern_tacarg strict onlytac ist = function
     TacGeneric arg
 
 (* Reads the rules of a Match Context or a Match *)
-and intern_match_rule onlytac ist = function
+and intern_match_rule onlytac ist ?(as_type=false) = function
   | (All tc)::tl ->
-      All (intern_tactic onlytac ist tc) :: (intern_match_rule onlytac ist tl)
+      All (intern_tactic onlytac ist tc) :: (intern_match_rule onlytac ist ~as_type tl)
   | (Pat (rl,mp,tc))::tl ->
       let {ltacvars=lfun; genv=env} = ist in
-      let lfun',metas1,hyps = intern_match_goal_hyps ist lfun rl in
-      let ido,metas2,pat = intern_pattern ist lfun mp in
+      let lfun',metas1,hyps = intern_match_goal_hyps ist ~as_type lfun rl in
+      let ido,metas2,pat = intern_pattern ist ~as_type lfun mp in
       let fold accu x = Id.Set.add x accu in
       let ltacvars = List.fold_left fold (opt_cons lfun' ido) metas1 in
       let ltacvars = List.fold_left fold ltacvars metas2 in
       let ist' = { ist with ltacvars } in
-      Pat (hyps,pat,intern_tactic onlytac ist' tc) :: (intern_match_rule onlytac ist tl)
+      Pat (hyps,pat,intern_tactic onlytac ist' tc) :: (intern_match_rule onlytac ist ~as_type tl)
   | [] -> []
 
 and intern_genarg ist (GenArg (Rawwit wit, x)) =
@@ -763,7 +749,7 @@ let print_ltac id =
     ++ spc() ++ Pptactic.pr_glob_tactic (Global.env ()) t) ++ redefined
  with
   Not_found ->
-   errorlabstrm "print_ltac"
+   user_err ~hdr:"print_ltac"
     (pr_qualid id ++ spc() ++ str "is not a user defined tactic.")
 
 (** Registering *)
@@ -790,13 +776,16 @@ let intern_ident' ist id =
   let lf = ref Id.Set.empty in
   (ist, intern_ident lf ist id)
 
+let intern_ltac ist tac =
+  Flags.with_option strict_check (fun () -> intern_pure_tactic ist tac) ()
+
 let () =
   Genintern.register_intern0 wit_int_or_var (lift intern_int_or_var);
   Genintern.register_intern0 wit_ref (lift intern_global_reference);
   Genintern.register_intern0 wit_ident intern_ident';
   Genintern.register_intern0 wit_var (lift intern_hyp);
   Genintern.register_intern0 wit_tactic (lift intern_tactic_or_tacarg);
-  Genintern.register_intern0 wit_ltac (lift intern_tactic_or_tacarg);
+  Genintern.register_intern0 wit_ltac (lift intern_ltac);
   Genintern.register_intern0 wit_quant_hyp (lift intern_quantified_hypothesis);
   Genintern.register_intern0 wit_constr (fun ist c -> (ist,intern_constr ist c));
   Genintern.register_intern0 wit_uconstr (fun ist c -> (ist,intern_constr ist c));
@@ -804,17 +793,20 @@ let () =
   Genintern.register_intern0 wit_red_expr (lift intern_red_expr);
   Genintern.register_intern0 wit_bindings (lift intern_bindings);
   Genintern.register_intern0 wit_constr_with_bindings (lift intern_constr_with_bindings);
+  Genintern.register_intern0 wit_destruction_arg (lift intern_destruction_arg);
   ()
 
-(***************************************************************************)
-(* Backwarding recursive needs of tactic glob/interp/eval functions *)
+(** Substitution for notations containing tactic-in-terms *)
 
-let _ =
-  let f l =
-    let ltacvars =
-      List.fold_left (fun accu x -> Id.Set.add x accu) Id.Set.empty l
-    in
-    Flags.with_option strict_check
-    (intern_pure_tactic { (make_empty_glob_sign()) with ltacvars })
+let notation_subst bindings tac =
+  let fold id c accu =
+    let loc = Glob_ops.loc_of_glob_constr (fst c) in
+    let c = ConstrMayEval (ConstrTerm c) in
+    ((loc, id), c) :: accu
   in
-  Hook.set Hints.extern_intern_tac f
+  let bindings = Id.Map.fold fold bindings [] in
+  (** This is theoretically not correct due to potential variable capture, but
+      Ltac has no true variables so one cannot simply substitute *)
+  TacLetIn (false, bindings, tac)
+
+let () = Genintern.register_ntn_subst0 wit_tactic notation_subst
diff --git a/ltac/tacinterp.ml b/ltac/tacinterp.ml
index fcc29a830..32bcdfb6a 100644
--- a/ltac/tacinterp.ml
+++ b/ltac/tacinterp.ml
@@ -13,7 +13,7 @@ open Genredexpr
 open Glob_term
 open Glob_ops
 open Tacred
-open Errors
+open CErrors
 open Util
 open Names
 open Nameops
@@ -31,7 +31,7 @@ open Tacexpr
 open Genarg
 open Geninterp
 open Stdarg
-open Constrarg
+open Tacarg
 open Printer
 open Pretyping
 open Misctypes
@@ -168,7 +168,7 @@ module Value = struct
     let pr_v = Pptactic.pr_value Pptactic.ltop v in
     let Val.Dyn (tag, _) = v in
     let tag = Val.pr tag in
-    errorlabstrm "" (str "Type error: value " ++ pr_v ++ str "is a " ++ tag
+    user_err  (str "Type error: value " ++ pr_v ++ str " is a " ++ tag
       ++ str " while type " ++ Val.pr wit ++ str " was expected.")
 
   let unbox wit v ans = match ans with
@@ -209,7 +209,7 @@ let catching_error call_trace fail (e, info) =
   in
   if List.is_empty call_trace && List.is_empty inner_trace then fail (e, info)
   else begin
-    assert (Errors.noncritical e); (* preserved invariant *)
+    assert (CErrors.noncritical e); (* preserved invariant *)
     let new_trace = inner_trace @ call_trace in
     let located_exc = (e, Exninfo.add info ltac_trace_info new_trace) in
     fail located_exc
@@ -217,8 +217,8 @@ let catching_error call_trace fail (e, info) =
 
 let catch_error call_trace f x =
   try f x
-  with e when Errors.noncritical e ->
-    let e = Errors.push e in
+  with e when CErrors.noncritical e ->
+    let e = CErrors.push e in
     catching_error call_trace iraise e
 
 let catch_error_tac call_trace tac =
@@ -286,9 +286,10 @@ let constr_of_id env id =
 
 (** Generic arguments : table of interpretation functions *)
 
+(* Some of the code further down depends on the fact that push_trace does not modify sigma (the evar map) *)
 let push_trace call ist = match TacStore.get ist.extra f_trace with
-| None -> [call]
-| Some trace -> call :: trace
+| None -> Proofview.tclUNIT [call]
+| Some trace -> Proofview.tclUNIT (call :: trace)
 
 let propagate_trace ist loc id v =
   let v = Value.normalize v in
@@ -297,10 +298,11 @@ let propagate_trace ist loc id v =
     match tacv with
     | VFun (appl,_,lfun,it,b) ->
         let t = if List.is_empty it then b else TacFun (it,b) in
-        let ans = VFun (appl,push_trace(loc,LtacVarCall (id,t)) ist,lfun,it,b) in
-        of_tacvalue ans
-    | _ ->  v
-  else v
+        push_trace(loc,LtacVarCall (id,t)) ist >>= fun trace ->
+        let ans = VFun (appl,trace,lfun,it,b) in
+        Proofview.tclUNIT (of_tacvalue ans)
+    | _ ->  Proofview.tclUNIT v
+  else Proofview.tclUNIT v
 
 let append_trace trace v =
   let v = Value.normalize v in
@@ -313,8 +315,8 @@ let append_trace trace v =
 (* Dynamically check that an argument is a tactic *)
 let coerce_to_tactic loc id v =
   let v = Value.normalize v in
-  let fail () = user_err_loc
-    (loc, "", str "Variable " ++ pr_id id ++ str " should be bound to a tactic.")
+  let fail () = user_err ~loc 
+    (str "Variable " ++ pr_id id ++ str " should be bound to a tactic.")
   in
   let v = Value.normalize v in
   if has_type v (topwit wit_tacvalue) then
@@ -369,7 +371,7 @@ let debugging_exception_step ist signal_anomaly e pp =
     pp() ++ spc() ++ str "raised the exception" ++ fnl() ++ explain_exc e)
 
 let error_ltac_variable loc id env v s =
-   user_err_loc (loc, "", str "Ltac variable " ++ pr_id id ++
+   user_err ~loc  (str "Ltac variable " ++ pr_id id ++
    strbrk " is bound to" ++ spc () ++ pr_value env v ++ spc () ++
    strbrk "which cannot be coerced to " ++ str s ++ str".")
 
@@ -383,11 +385,9 @@ let interp_ltac_var coerce ist env locid =
   with Not_found -> anomaly (str "Detected '" ++ Id.print (snd locid) ++ str "' as ltac var at interning time")
 
 let interp_ident ist env sigma id =
-  try try_interp_ltac_var (coerce_to_ident false env) ist (Some (env,sigma)) (dloc,id)
+  try try_interp_ltac_var (coerce_var_to_ident false env) ist (Some (env,sigma)) (dloc,id)
   with Not_found -> id
 
-let pf_interp_ident id gl = interp_ident id (pf_env gl) (project gl)
-
 (* Interprets an optional identifier, bound or fresh *)
 let interp_name ist env sigma = function
   | Anonymous -> Anonymous
@@ -404,8 +404,8 @@ let interp_intro_pattern_naming_var loc ist env sigma id =
 let interp_int ist locid =
   try try_interp_ltac_var coerce_to_int ist None locid
   with Not_found ->
-    user_err_loc(fst locid,"interp_int",
-      str "Unbound variable "  ++ pr_id (snd locid) ++ str".")
+    user_err ~loc:(fst locid) ~hdr:"interp_int"
+     (str "Unbound variable "  ++ pr_id (snd locid) ++ str".")
 
 let interp_int_or_var ist = function
   | ArgVar locid -> interp_int ist locid
@@ -427,7 +427,7 @@ let interp_hyp ist env sigma (loc,id as locid) =
   with Not_found ->
   (* Then look if bound in the proof context at calling time *)
   if is_variable env id then id
-  else Loc.raise loc (Logic.RefinerError (Logic.NoSuchHyp id))
+  else Loc.raise ~loc (Logic.RefinerError (Logic.NoSuchHyp id))
 
 let interp_hyp_list_as_list ist env sigma (loc,id as x) =
   try coerce_to_hyp_list env (Id.Map.find id ist.lfun)
@@ -449,7 +449,7 @@ let interp_reference ist env sigma = function
     with Not_found ->
       try
         VarRef (get_id (Environ.lookup_named id env))
-      with Not_found -> error_global_not_found_loc loc (qualid_of_ident id)
+      with Not_found -> error_global_not_found ~loc (qualid_of_ident id)
 
 let try_interp_evaluable env (loc, id) =
   let v = Environ.lookup_named id env in
@@ -465,14 +465,14 @@ let interp_evaluable ist env sigma = function
       with Not_found ->
         match r with
         | EvalConstRef _ -> r
-        | _ -> error_global_not_found_loc loc (qualid_of_ident id)
+        | _ -> error_global_not_found ~loc (qualid_of_ident id)
     end
   | ArgArg (r,None) -> r
   | ArgVar (loc, id) ->
     try try_interp_ltac_var (coerce_to_evaluable_ref env) ist (Some (env,sigma)) (loc, id)
     with Not_found ->
       try try_interp_evaluable env (loc, id)
-      with Not_found -> error_global_not_found_loc loc (qualid_of_ident id)
+      with Not_found -> error_global_not_found ~loc (qualid_of_ident id)
 
 (* Interprets an hypothesis name *)
 let interp_occurrences ist occs =
@@ -539,6 +539,10 @@ let extract_ids ids lfun =
 let default_fresh_id = Id.of_string "H"
 
 let interp_fresh_id ist env sigma l =
+  let extract_ident ist env sigma id =
+    try try_interp_ltac_var (coerce_to_ident_not_fresh sigma env)
+			    ist (Some (env,sigma)) (dloc,id)
+    with Not_found -> id in
   let ids = List.map_filter (function ArgVar (_, id) -> Some id | _ -> None) l in
   let avoid = match TacStore.get ist.extra f_avoid_ids with
   | None -> []
@@ -551,7 +555,7 @@ let interp_fresh_id ist env sigma l =
       let s =
 	String.concat "" (List.map (function
 	  | ArgArg s -> s
-	  | ArgVar (_,id) -> Id.to_string (interp_ident ist env sigma id)) l) in
+	  | ArgVar (_,id) -> Id.to_string (extract_ident ist env sigma id)) l) in
       let s = if CLexer.is_keyword s then s^"0" else s in
       Id.of_string s in
   Tactics.fresh_id_in_env avoid id env
@@ -568,7 +572,7 @@ let extract_ltac_constr_context ist env =
     with CannotCoerceTo _ -> map
   in
   let add_ident id env v map =
-    try Id.Map.add id (coerce_to_ident false env v) map
+    try Id.Map.add id (coerce_var_to_ident false env v) map
     with CannotCoerceTo _ -> map
   in
   let fold id v {idents;typed;untyped} =
@@ -622,8 +626,13 @@ let interp_gen kind ist allow_patvar flags env sigma (c,ce) =
         match kind with OfType _ -> WithoutTypeConstraint | _ -> kind in
       intern_gen kind_for_intern ~allow_patvar ~ltacvars env c
   in
-  let trace =
-    push_trace (loc_of_glob_constr c,LtacConstrInterp (c,vars)) ist in
+  (* Jason Gross: To avoid unnecessary modifications to tacinterp, as
+      suggested by Arnaud Spiwack, we run push_trace immediately.  We do
+      this with the kludge of an empty proofview, and rely on the
+      invariant that running the tactic returned by push_trace does
+      not modify sigma. *)
+  let (_, dummy_proofview) = Proofview.init sigma [] in
+  let (trace,_,_,_) = Proofview.apply env (push_trace (loc_of_glob_constr c,LtacConstrInterp (c,vars)) ist) dummy_proofview in
   let (evd,c) =
     catch_error trace (understand_ltac flags env sigma vars kind) c
   in
@@ -635,7 +644,7 @@ let interp_gen kind ist allow_patvar flags env sigma (c,ce) =
 
 let constr_flags = {
   use_typeclasses = true;
-  use_unif_heuristics = true;
+  solve_unification_constraints = true;
   use_hook = Some solve_by_implicit_tactic;
   fail_evar = true;
   expand_evars = true }
@@ -650,21 +659,21 @@ let interp_type = interp_constr_gen IsType
 
 let open_constr_use_classes_flags = {
   use_typeclasses = true;
-  use_unif_heuristics = true;
+  solve_unification_constraints = true;
   use_hook = Some solve_by_implicit_tactic;
   fail_evar = false;
   expand_evars = true }
 
 let open_constr_no_classes_flags = {
   use_typeclasses = false;
-  use_unif_heuristics = true;
+  solve_unification_constraints = true;
   use_hook = Some solve_by_implicit_tactic;
   fail_evar = false;
   expand_evars = true }
 
 let pure_open_constr_flags = {
   use_typeclasses = false;
-  use_unif_heuristics = true;
+  solve_unification_constraints = true;
   use_hook = None;
   fail_evar = false;
   expand_evars = false }
@@ -684,14 +693,7 @@ let interp_typed_pattern ist env sigma (_,c,_) =
     interp_gen WithoutTypeConstraint ist true pure_open_constr_flags env sigma c in
   pattern_of_constr env sigma c
 
-(* Interprets a constr expression casted by the current goal *)
-let pf_interp_casted_constr ist gl c =
-  interp_constr_gen (OfType (pf_concl gl)) ist (pf_env gl) (project gl) c
-
 (* Interprets a constr expression *)
-let pf_interp_constr ist gl =
-  interp_constr ist (pf_env gl) (project gl)
-
 let interp_constr_in_compound_list inj_fun dest_fun interp_fun ist env sigma l =
   let try_expand_ltac_var sigma x =
     try match dest_fun x with
@@ -713,10 +715,6 @@ let interp_constr_list ist env sigma c =
 let interp_open_constr_list =
   interp_constr_in_compound_list (fun x -> x) (fun x -> x) interp_open_constr
 
-(* Interprets a type expression *)
-let pf_interp_type ist env sigma =
-  interp_type ist env sigma
-
 (* Interprets a reduction expression *)
 let interp_unfold ist env sigma (occs,qid) =
   (interp_occurrences ist occs,interp_evaluable ist env sigma qid)
@@ -741,7 +739,7 @@ let interp_closed_typed_pattern_with_occurrences ist env sigma (occs, a) =
         Inr (pattern_of_constr env sigma c) in
     (try try_interp_ltac_var coerce_eval_ref_or_constr ist (Some (env,sigma)) (loc,id)
      with Not_found ->
-       error_global_not_found_loc loc (qualid_of_ident id))
+       error_global_not_found ~loc (qualid_of_ident id))
   | Inl (ArgArg _ as b) -> Inl (interp_evaluable ist env sigma b)
   | Inr c -> Inr (interp_typed_pattern ist env sigma c) in
   interp_occurrences ist occs, p
@@ -797,8 +795,8 @@ let interp_may_eval f ist env sigma = function
 	!evdref , c
       with
 	| Not_found ->
-	    user_err_loc (loc, "interp_may_eval",
-	    str "Unbound context identifier" ++ pr_id s ++ str"."))
+	    user_err ~loc ~hdr:"interp_may_eval"
+	    (str "Unbound context identifier" ++ pr_id s ++ str"."))
   | ConstrTypeOf c ->
       let (sigma,c_interp) = f ist env sigma c in
       Typing.type_of ~refresh:true env sigma c_interp
@@ -806,7 +804,7 @@ let interp_may_eval f ist env sigma = function
      try
 	f ist env sigma c
      with reraise ->
-       let reraise = Errors.push reraise in
+       let reraise = CErrors.push reraise in
        (* spiwack: to avoid unnecessary modifications of tacinterp, as this
           function already use effect, I call [run] hoping it doesn't mess
           up with any assumption. *)
@@ -820,7 +818,7 @@ let interp_constr_may_eval ist env sigma c =
     try
       interp_may_eval interp_constr ist env sigma c
     with reraise ->
-      let reraise = Errors.push reraise in
+      let reraise = CErrors.push reraise in
       (* spiwack: to avoid unnecessary modifications of tacinterp, as this
           function already use effect, I call [run] hoping it doesn't mess
           up with any assumption. *)
@@ -868,6 +866,9 @@ let rec message_of_value v =
       Ftactic.return (pr_closed_glob_env (pf_env gl)
                         (project gl) c)
     end }
+  else if has_type v (topwit wit_var) then
+    let id = out_gen (topwit wit_var) v in
+    Ftactic.nf_enter { enter = begin fun gl -> Ftactic.return (pr_id id) end }
   else match Value.to_list v with
   | Some l ->
     Ftactic.List.map message_of_value l >>= fun l ->
@@ -947,7 +948,7 @@ let interp_or_and_intro_pattern_option ist env sigma = function
       (match coerce_to_intro_pattern env (Id.Map.find id ist.lfun) with
       | IntroAction (IntroOrAndPattern l) -> sigma, Some (loc,l)
       | _ ->
-        raise (CannotCoerceTo "a disjunctive/conjunctive introduction pattern"))
+        user_err ~loc (str "Cannot coerce to a disjunctive/conjunctive pattern."))
   | Some (ArgArg (loc,l)) ->
       let sigma,l = interp_or_and_intro_pattern ist env sigma l in
       sigma, Some (loc,l)
@@ -1024,7 +1025,7 @@ let interp_open_constr_with_bindings_loc ist ((c,_),bl as cb) =
   } in
     (loc,f)
 
-let interp_induction_arg ist gl arg =
+let interp_destruction_arg ist gl arg =
   match arg with
   | keep,ElimOnConstr c ->
       keep,ElimOnConstr { delayed = fun env sigma ->
@@ -1034,8 +1035,8 @@ let interp_induction_arg ist gl arg =
       }
   | keep,ElimOnAnonHyp n as x -> x
   | keep,ElimOnIdent (loc,id) ->
-      let error () = user_err_loc (loc, "",
-        strbrk "Cannot coerce " ++ pr_id id ++
+      let error () = user_err ~loc 
+       (strbrk "Cannot coerce " ++ pr_id id ++
         strbrk " neither to a quantified hypothesis nor to a term.")
       in
       let try_cast_id id' =
@@ -1045,7 +1046,7 @@ let interp_induction_arg ist gl arg =
           (keep, ElimOnConstr { delayed = begin fun env sigma ->
           try Sigma.here (constr_of_id env id', NoBindings) sigma
           with Not_found ->
-            user_err_loc (loc, "interp_induction_arg",
+            user_err ~loc  ~hdr:"interp_destruction_arg" (
             pr_id id ++ strbrk " binds to " ++ pr_id id' ++ strbrk " which is neither a declared nor a quantified hypothesis.")
           end })
       in
@@ -1113,7 +1114,7 @@ let read_pattern lfun ist env sigma = function
 (* Reads the hypotheses of a Match Context rule *)
 let cons_and_check_name id l =
   if Id.List.mem id l then
-    user_err_loc (dloc,"read_match_goal_hyps",
+    user_err ~hdr:"read_match_goal_hyps" (
       str "Hypothesis pattern-matching variable " ++ pr_id id ++
       str " used twice in the same pattern.")
   else id::l
@@ -1137,6 +1138,12 @@ let rec read_match_rule lfun ist env sigma = function
       :: read_match_rule lfun ist env sigma tl
   | [] -> []
 
+let warn_deprecated_info =
+  CWarnings.create ~name:"deprecated-info-tactical" ~category:"deprecated"
+         (fun () ->
+          strbrk "The general \"info\" tactic is currently not working." ++ spc()++
+            strbrk "There is an \"Info\" command to replace it." ++fnl () ++
+            strbrk "Some specific verbose tactics may also exist, such as info_eauto.")
 
 (* Interprets an l-tac expression into a value *)
 let rec val_interp ist ?(appl=UnnamedAppl) (tac:glob_tactic_expr) : Val.t Ftactic.t =
@@ -1173,7 +1180,9 @@ let rec val_interp ist ?(appl=UnnamedAppl) (tac:glob_tactic_expr) : Val.t Ftacti
 and eval_tactic ist tac : unit Proofview.tactic = match tac with
   | TacAtom (loc,t) ->
       let call = LtacAtomCall t in
-      catch_error_tac (push_trace(loc,call) ist) (interp_atomic ist t)
+      push_trace(loc,call) ist >>= fun trace ->
+      Profile_ltac.do_profile "eval_tactic:2" trace
+        (catch_error_tac trace (interp_atomic ist t))
   | TacFun _ | TacLetIn _ -> assert false
   | TacMatchGoal _ | TacMatch _ -> assert false
   | TacId [] -> Proofview.tclLIFT (db_breakpoint (curr_debug ist) [])
@@ -1205,7 +1214,7 @@ and eval_tactic ist tac : unit Proofview.tactic = match tac with
          end
   | TacAbstract (tac,ido) ->
       Proofview.Goal.nf_enter { enter = begin fun gl -> Tactics.tclABSTRACT
-        (Option.map (pf_interp_ident ist gl) ido) (interp_tactic ist tac)
+        (Option.map (interp_ident ist (pf_env gl) (project gl)) ido) (interp_tactic ist tac)
       end }
   | TacThen (t1,t) ->
       Tacticals.New.tclTHEN (interp_tactic ist t1) (interp_tactic ist t)
@@ -1242,11 +1251,9 @@ and eval_tactic ist tac : unit Proofview.tactic = match tac with
   | TacComplete tac -> Tacticals.New.tclCOMPLETE (interp_tactic ist tac)
   | TacArg a -> interp_tactic ist (TacArg a)
   | TacInfo tac ->
-      Feedback.msg_warning
-	(strbrk "The general \"info\" tactic is currently not working." ++ spc()++
-           strbrk "There is an \"Info\" command to replace it." ++fnl () ++
-	   strbrk "Some specific verbose tactics may also exist, such as info_eauto.");
+      warn_deprecated_info ();
       eval_tactic ist tac
+  | TacSelect (sel, tac) -> Tacticals.New.tclSELECT sel (interp_tactic ist tac)
   (* For extensions *)
   | TacAlias (loc,s,l) ->
       let (ids, body) = Tacenv.interp_alias s in
@@ -1255,7 +1262,7 @@ and eval_tactic ist tac : unit Proofview.tactic = match tac with
       let tac l =
         let addvar x v accu = Id.Map.add x v accu in
         let lfun = List.fold_right2 addvar ids l ist.lfun in
-        let trace = push_trace (loc,LtacNotationCall s) ist in
+        Ftactic.lift (push_trace (loc,LtacNotationCall s) ist) >>= fun trace ->
         let ist = {
           lfun = lfun;
           extra = TacStore.set ist.extra f_trace trace; } in
@@ -1280,7 +1287,7 @@ and eval_tactic ist tac : unit Proofview.tactic = match tac with
       Ftactic.run tac (fun () -> Proofview.tclUNIT ())
 
   | TacML (loc,opn,l) ->
-      let trace = push_trace (loc,LtacMLCall tac) ist in
+      push_trace (loc,LtacMLCall tac) ist >>= fun trace ->
       let ist = { ist with extra = TacStore.set ist.extra f_trace trace; } in
       let tac = Tacenv.interp_ml_tactic opn in
       let args = Ftactic.List.map_right (fun a -> interp_tacarg ist a) l in
@@ -1306,15 +1313,17 @@ and interp_ltac_reference loc' mustbetac ist r : Val.t Ftactic.t =
         try Id.Map.find id ist.lfun
         with Not_found -> in_gen (topwit wit_var) id
       in
-      Ftactic.bind (force_vrec ist v) begin fun v ->
-      let v = propagate_trace ist loc id v in
+      let open Ftactic in
+      force_vrec ist v >>= begin fun v ->
+      Ftactic.lift (propagate_trace ist loc id v) >>= fun v ->
       if mustbetac then Ftactic.return (coerce_to_tactic loc id v) else Ftactic.return v
       end
   | ArgArg (loc,r) ->
       let ids = extract_ids [] ist.lfun in
       let loc_info = ((if Loc.is_ghost loc' then loc else loc'),LtacNameCall r) in
-      let extra = TacStore.set ist.extra f_avoid_ids ids in 
-      let extra = TacStore.set extra f_trace (push_trace loc_info ist) in
+      let extra = TacStore.set ist.extra f_avoid_ids ids in
+      push_trace loc_info ist >>= fun trace ->
+      let extra = TacStore.set extra f_trace trace in
       let ist = { lfun = Id.Map.empty; extra = extra; } in
       let appl = GlbAppl[r,[]] in
       val_interp ~appl ist (Tacenv.interp_ltac r)
@@ -1412,7 +1421,7 @@ and tactic_of_value ist vle =
         lfun = lfun;
         extra = TacStore.set ist.extra f_trace []; } in
       let tac = name_if_glob appl (eval_tactic ist t) in
-      catch_error_tac trace tac
+      Profile_ltac.do_profile "tactic_of_value" trace (catch_error_tac trace tac)
   | (VFun _|VRec _) -> Tacticals.New.tclZEROMSG (str "A fully applied tactic is expected.")
   else if has_type vle (topwit wit_tactic) then
     let tac = out_gen (topwit wit_tactic) vle in
@@ -1567,7 +1576,7 @@ and interp_genarg_constr_list ist x =
   end }
 
 and interp_genarg_var_list ist x =
-  Ftactic.nf_enter { enter = begin fun gl ->
+  Ftactic.enter { enter = begin fun gl ->
   let env = Proofview.Goal.env gl in
   let sigma = Sigma.to_evar_map (Proofview.Goal.sigma gl) in
   let lc = Genarg.out_gen (glbwit (wit_list wit_var)) x in
@@ -1632,36 +1641,18 @@ and name_atomic ?env tacexpr tac : unit Proofview.tactic =
 and interp_atomic ist tac : unit Proofview.tactic =
   match tac with
   (* Basic tactics *)
-  | TacIntroPattern l ->
+  | TacIntroPattern (ev,l) ->
       Proofview.Goal.enter { enter = begin fun gl ->
         let env = Proofview.Goal.env gl in
         let sigma = project gl in
         let sigma,l' = interp_intro_pattern_list_as_list ist env sigma l in
-        Tacticals.New.tclWITHHOLES false 
+        Tacticals.New.tclWITHHOLES ev
         (name_atomic ~env
-          (TacIntroPattern l)
+          (TacIntroPattern (ev,l))
           (* spiwack: print uninterpreted, not sure if it is the
              expected behaviour. *)
-          (Tactics.intro_patterns l')) sigma
+          (Tactics.intro_patterns ev l')) sigma
       end }
-  | TacIntroMove (ido,hto) ->
-      Proofview.Goal.enter { enter = begin fun gl ->
-        let env = Proofview.Goal.env gl in
-        let sigma = project gl in
-        let mloc = interp_move_location ist env sigma hto in
-        let ido = Option.map (interp_ident ist env sigma) ido in
-        name_atomic ~env
-          (TacIntroMove(ido,mloc))
-          (Tactics.intro_move ido mloc)
-      end }
-  | TacExact c ->
-      (* spiwack: until the tactic is in the monad *)
-      Proofview.Trace.name_tactic (fun () -> Pp.str"<exact>") begin
-      Proofview.Goal.nf_s_enter { s_enter = begin fun gl ->
-        let (sigma, c_interp) = pf_interp_casted_constr ist gl c in
-        Sigma.Unsafe.of_pair (Tactics.exact_no_check c_interp, sigma)
-      end }
-      end
   | TacApply (a,ev,cb,cl) ->
       (* spiwack: until the tactic is in the monad *)
       Proofview.Trace.name_tactic (fun () -> Pp.str"<apply>") begin
@@ -1709,7 +1700,7 @@ and interp_atomic ist tac : unit Proofview.tactic =
       Proofview.Goal.nf_s_enter { s_enter = begin fun gl ->
         let env = pf_env gl in
         let f sigma (id,n,c) =
-          let (sigma,c_interp) = pf_interp_type ist env sigma c in
+          let (sigma,c_interp) = interp_type ist env sigma c in
 	  sigma , (interp_ident ist env sigma id,n,c_interp) in
         let (sigma,l_interp) =
           Evd.MonadR.List.map_right (fun c sigma -> f sigma c) l (project gl)
@@ -1724,7 +1715,7 @@ and interp_atomic ist tac : unit Proofview.tactic =
       Proofview.Goal.nf_s_enter { s_enter = begin fun gl ->
         let env = pf_env gl in
         let f sigma (id,c) =
-	  let (sigma,c_interp) = pf_interp_type ist env sigma c in
+	  let (sigma,c_interp) = interp_type ist env sigma c in
 	  sigma , (interp_ident ist env sigma id,c_interp) in
         let (sigma,l_interp) =
           Evd.MonadR.List.map_right (fun c sigma -> f sigma c) l (project gl)
@@ -1741,10 +1732,10 @@ and interp_atomic ist tac : unit Proofview.tactic =
           (if Option.is_empty t then interp_constr else interp_type) ist env sigma c
         in
         let sigma, ipat' = interp_intro_pattern_option ist env sigma ipat in
-        let tac = Option.map (interp_tactic ist) t in
+        let tac = Option.map (Option.map (interp_tactic ist)) t in
         Tacticals.New.tclWITHHOLES false
         (name_atomic ~env
-          (TacAssert(b,Option.map ignore t,ipat,c))
+          (TacAssert(b,Option.map (Option.map ignore) t,ipat,c))
           (Tactics.forward b tac ipat' c)) sigma
       end }
   | TacGeneralize cl ->
@@ -1766,7 +1757,7 @@ and interp_atomic ist tac : unit Proofview.tactic =
         let eqpat = interp_intro_pattern_naming_option ist env sigma eqpat in
         if Locusops.is_nowhere clp then
         (* We try to fully-typecheck the term *)
-          let (sigma,c_interp) = pf_interp_constr ist gl c in
+          let (sigma,c_interp) = interp_constr ist env sigma c in
           let let_tac b na c cl eqpat =
             let id = Option.default (Loc.ghost,IntroAnonymous) eqpat in
             let with_eq = if b then None else Some (true,id) in
@@ -1805,7 +1796,7 @@ and interp_atomic ist tac : unit Proofview.tactic =
             (* TODO: move sigma as a side-effect *)
              (* spiwack: the [*p] variants are for printing *)
             let cp = c in
-            let c = interp_induction_arg ist gl c in
+            let c = interp_destruction_arg ist gl c in
             let ipato = interp_intro_pattern_naming_option ist env sigma ipato in
             let ipatsp = ipats in
             let sigma,ipats = interp_or_and_intro_pattern_option ist env sigma ipats in
@@ -1822,36 +1813,13 @@ and interp_atomic ist tac : unit Proofview.tactic =
         in
         Sigma.Unsafe.of_pair (tac, sigma)
       end }
-  | TacDoubleInduction (h1,h2) ->
-      let h1 = interp_quantified_hypothesis ist h1 in
-      let h2 = interp_quantified_hypothesis ist h2 in
-      name_atomic
-        (TacDoubleInduction (h1,h2))
-        (Elim.h_double_induction h1 h2)
-  (* Context management *)
-  | TacRename l ->
-      Proofview.Goal.enter { enter = begin fun gl ->
-        let env = pf_env gl in
-        let sigma = project gl in
-        let l =
-          List.map (fun (id1,id2) ->
-	    interp_hyp ist env sigma id1,
-	    interp_ident ist env sigma (snd id2)) l
-        in
-        name_atomic ~env
-          (TacRename l)
-          (Tactics.rename_hyp l)
-      end }
 
   (* Conversion *)
   | TacReduce (r,cl) ->
-      (* spiwack: until the tactic is in the monad *)
-      Proofview.Trace.name_tactic (fun () -> Pp.str"<reduce>") begin
       Proofview.Goal.nf_s_enter { s_enter = begin fun gl ->
         let (sigma,r_interp) = interp_red_expr ist (pf_env gl) (project gl) r in
         Sigma.Unsafe.of_pair (Tactics.reduce r_interp (interp_clause ist (pf_env gl) (project gl) cl), sigma)
       end }
-      end
   | TacChange (None,c,cl) ->
       (* spiwack: until the tactic is in the monad *)
       Proofview.Trace.name_tactic (fun () -> Pp.str"<change>") begin
@@ -1890,7 +1858,7 @@ and interp_atomic ist tac : unit Proofview.tactic =
         let env = Proofview.Goal.env gl in
         let sigma = project gl in
         let op = interp_typed_pattern ist env sigma op in
-        let to_catch = function Not_found -> true | e -> Errors.is_anomaly e in
+        let to_catch = function Not_found -> true | e -> CErrors.is_anomaly e in
         let c_interp patvars = { Sigma.run = begin fun sigma ->
           let lfun' = Id.Map.fold (fun id c lfun ->
             Id.Map.add id (Value.of_constr c) lfun) 
@@ -1902,7 +1870,7 @@ and interp_atomic ist tac : unit Proofview.tactic =
               let (sigma, c) = interp_constr ist env sigma c in
               Sigma.Unsafe.of_pair (c, sigma)
             with e when to_catch e (* Hack *) ->
-              errorlabstrm "" (strbrk "Failed to get enough information from the left-hand side to type the right-hand side.")
+              user_err  (strbrk "Failed to get enough information from the left-hand side to type the right-hand side.")
         end } in
         Tactics.change (Some op) c_interp (interp_clause ist env sigma cl)
       end }
@@ -1937,7 +1905,7 @@ and interp_atomic ist tac : unit Proofview.tactic =
           match c with
           | None -> sigma , None
           | Some c ->
-              let (sigma,c_interp) = pf_interp_constr ist gl c in
+              let (sigma,c_interp) = interp_constr ist env sigma c in
               sigma , Some c_interp
         in
         let dqhyps = interp_declared_or_quantified_hypothesis ist env sigma hyp in
@@ -2004,7 +1972,6 @@ let interp_tac_gen lfun avoid_ids debug t =
   end }
 
 let interp t = interp_tac_gen Id.Map.empty [] (get_debug()) t
-let _ = Proof_global.set_interp_tac interp
 
 (* Used to hide interpretation for pretty-print, now just launch tactics *)
 (* [global] means that [t] should be internalized outside of goals. *)
@@ -2059,7 +2026,7 @@ let () =
 let () =
   declare_uniform wit_pre_ident
 
-let lift f = (); fun ist x -> Ftactic.nf_enter { enter = begin fun gl ->
+let lift f = (); fun ist x -> Ftactic.enter { enter = begin fun gl ->
   let env = Proofview.Goal.env gl in
   let sigma = Sigma.to_evar_map (Proofview.Goal.sigma gl) in
   Ftactic.return (f ist env sigma x)
@@ -2082,6 +2049,10 @@ let interp_constr_with_bindings' ist c = Ftactic.return { delayed = fun env sigm
   Sigma.Unsafe.of_pair (c, sigma)
   }
 
+let interp_destruction_arg' ist c = Ftactic.nf_enter { enter = begin fun gl ->
+  Ftactic.return (interp_destruction_arg ist gl c)
+end }
+
 let () =
   register_interp0 wit_int_or_var (fun ist n -> Ftactic.return (interp_int_or_var ist n));
   register_interp0 wit_ref (lift interp_reference);
@@ -2096,6 +2067,7 @@ let () =
   register_interp0 wit_open_constr (lifts interp_open_constr);
   register_interp0 wit_bindings interp_bindings';
   register_interp0 wit_constr_with_bindings interp_constr_with_bindings';
+  register_interp0 wit_destruction_arg interp_destruction_arg';
   ()
 
 let () =
diff --git a/ltac/tacinterp.mli b/ltac/tacinterp.mli
index 8bb6ee4cd..6f64981ef 100644
--- a/ltac/tacinterp.mli
+++ b/ltac/tacinterp.mli
@@ -72,6 +72,9 @@ val interp_redexp : Environ.env -> Evd.evar_map -> raw_red_expr -> Evd.evar_map
 val interp_hyp : interp_sign -> Environ.env -> Evd.evar_map ->
   Id.t Loc.located -> Id.t
 
+val interp_constr_gen : Pretyping.typing_constraint -> interp_sign ->
+  Environ.env -> Evd.evar_map -> glob_constr_and_expr -> Evd.evar_map * constr
+
 val interp_bindings : interp_sign -> Environ.env -> Evd.evar_map ->
  glob_constr_and_expr bindings -> Evd.evar_map * constr bindings
 
diff --git a/ltac/tacsubst.ml b/ltac/tacsubst.ml
index 3f504b7f3..55de58361 100644
--- a/ltac/tacsubst.ml
+++ b/ltac/tacsubst.ml
@@ -10,7 +10,8 @@ open Util
 open Tacexpr
 open Mod_subst
 open Genarg
-open Constrarg
+open Stdarg
+open Tacarg
 open Misctypes
 open Globnames
 open Term
@@ -63,7 +64,7 @@ and subst_intro_or_and_pattern subst = function
   | IntroOrPattern ll ->
       IntroOrPattern (List.map (List.map (subst_intro_pattern subst)) ll)
 
-let subst_induction_arg subst = function
+let subst_destruction_arg subst = function
   | clear,ElimOnConstr c -> clear,ElimOnConstr (subst_glob_with_bindings subst c)
   | clear,ElimOnAnonHyp n as x -> x
   | clear,ElimOnIdent id as x -> x
@@ -136,9 +137,7 @@ let rec subst_match_goal_hyps subst = function
 
 let rec subst_atomic subst (t:glob_atomic_tactic_expr) = match t with
   (* Basic tactics *)
-  | TacIntroPattern l -> TacIntroPattern (List.map (subst_intro_pattern subst) l)
-  | TacIntroMove _ as x -> x
-  | TacExact c -> TacExact (subst_glob_constr subst c)
+  | TacIntroPattern (ev,l) -> TacIntroPattern (ev,List.map (subst_intro_pattern subst) l)
   | TacApply (a,ev,cb,cl) ->
       TacApply (a,ev,List.map (subst_glob_with_bindings_arg subst) cb,cl)
   | TacElim (ev,cb,cbo) ->
@@ -150,7 +149,8 @@ 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_glob_constr subst c)) l)
   | TacAssert (b,otac,na,c) ->
-      TacAssert (b,Option.map (subst_tactic subst) otac,na,subst_glob_constr subst c)
+      TacAssert (b,Option.map (Option.map (subst_tactic subst)) otac,na,
+                 subst_glob_constr subst c)
   | TacGeneralize cl ->
       TacGeneralize (List.map (on_fst (subst_constr_with_occurrences subst))cl)
   | TacLetTac (id,c,clp,b,eqpat) ->
@@ -159,13 +159,9 @@ let rec subst_atomic subst (t:glob_atomic_tactic_expr) = match t with
   (* Derived basic tactics *)
   | TacInductionDestruct (isrec,ev,(l,el)) ->
       let l' = List.map (fun (c,ids,cls) ->
-        subst_induction_arg subst c, ids, cls) l in
+        subst_destruction_arg subst c, ids, cls) l in
       let el' = Option.map (subst_glob_with_bindings subst) el in
       TacInductionDestruct (isrec,ev,(l',el'))
-  | TacDoubleInduction (h1,h2) as x -> x
-
-  (* Context management *)
-  | TacRename l as x -> x
 
   (* Conversion *)
   | TacReduce (r,cl) -> TacReduce (subst_redexp subst r, cl)
@@ -234,6 +230,7 @@ and subst_tactic subst (t:glob_tactic_expr) = match t with
   | TacSolve l -> TacSolve (List.map (subst_tactic subst) l)
   | TacComplete tac -> TacComplete (subst_tactic subst tac)
   | TacArg (_,a) -> TacArg (dloc,subst_tacarg subst a)
+  | TacSelect (s, tac) -> TacSelect (s, subst_tactic subst tac)
 
   (* For extensions *)
   | TacAlias (_,s,l) ->
@@ -307,4 +304,5 @@ let () =
   Genintern.register_subst0 wit_quant_hyp subst_declared_or_quantified_hypothesis;
   Genintern.register_subst0 wit_bindings subst_bindings;
   Genintern.register_subst0 wit_constr_with_bindings subst_glob_with_bindings;
+  Genintern.register_subst0 wit_destruction_arg subst_destruction_arg;
   ()
diff --git a/ltac/tactic_debug.ml b/ltac/tactic_debug.ml
index d661f9677..5cbddc7f6 100644
--- a/ltac/tactic_debug.ml
+++ b/ltac/tactic_debug.ml
@@ -36,10 +36,11 @@ type debug_info =
 
 (* An exception handler *)
 let explain_logic_error e =
-  Errors.print (fst (Cerrors.process_vernac_interp_error (e, Exninfo.null)))
+  CErrors.print (fst (ExplainErr.process_vernac_interp_error (e, Exninfo.null)))
 
 let explain_logic_error_no_anomaly e =
-  Errors.print_no_report (fst (Cerrors.process_vernac_interp_error (e, Exninfo.null)))
+  CErrors.print_no_report
+    (fst (ExplainErr.process_vernac_interp_error (e, Exninfo.null)))
 
 let msg_tac_debug s = Proofview.NonLogical.print_debug (s++fnl())
 let msg_tac_notice s = Proofview.NonLogical.print_notice (s++fnl())
@@ -330,10 +331,9 @@ let db_breakpoint debug s =
 
 let is_defined_ltac trace =
   let rec aux = function
-  | (_, Tacexpr.LtacNameCall f) :: tail ->
-      not (Tacenv.is_ltac_for_ml_tactic f)
-  | (_, Tacexpr.LtacAtomCall _) :: tail ->
-      false
+  | (_, Tacexpr.LtacNameCall f) :: _ -> not (Tacenv.is_ltac_for_ml_tactic f)
+  | (_, Tacexpr.LtacNotationCall f) :: _ -> true
+  | (_, Tacexpr.LtacAtomCall _) :: _ -> false
   | _ :: tail -> aux tail
   | [] -> false in
   aux (List.rev trace)
@@ -341,7 +341,7 @@ let is_defined_ltac trace =
 let explain_ltac_call_trace last trace loc =
   let calls = last :: List.rev_map snd trace in
   let pr_call ck = match ck with
-  | Tacexpr.LtacNotationCall kn -> quote (KerName.print kn)
+    | Tacexpr.LtacNotationCall kn -> quote (Pptactic.pr_alias_key kn)
   | Tacexpr.LtacNameCall cst -> quote (Pptactic.pr_ltac_constant cst)
   | Tacexpr.LtacMLCall t ->
       quote (Pptactic.pr_glob_tactic (Global.env()) t)
@@ -363,6 +363,7 @@ let explain_ltac_call_trace last trace loc =
   in
   match calls with
   | [] -> mt ()
+  | [a] -> hov 0 (str "Ltac call to " ++ pr_call a ++ str " failed.")
   | _ ->
     let kind_of_last_call = match List.last calls with
     | Tacexpr.LtacConstrInterp _ -> ", last term evaluation failed."
@@ -373,14 +374,19 @@ let explain_ltac_call_trace last trace loc =
 
 let skip_extensions trace =
   let rec aux = function
-  | (_,Tacexpr.LtacNameCall f as tac) :: _ 
-      when Tacenv.is_ltac_for_ml_tactic f -> [tac]
-  | (_,(Tacexpr.LtacNotationCall _ | Tacexpr.LtacMLCall _) as tac)
-      :: _ -> [tac]
+  | (_,Tacexpr.LtacNameCall f as tac) :: _
+       when Tacenv.is_ltac_for_ml_tactic f -> [tac]
+  | (_,Tacexpr.LtacNotationCall _ as tac) :: (_,Tacexpr.LtacMLCall _) :: _ ->
+     (* Case of an ML defined tactic with entry of the form <<"foo" args>> *)
+     (* see tacextend.mlp *)
+     [tac]
+  | (_,Tacexpr.LtacMLCall _ as tac) :: _ -> [tac]
   | t :: tail -> t :: aux tail
   | [] -> [] in
   List.rev (aux (List.rev trace))
 
+let finer_loc loc1 loc2 = Loc.merge loc1 loc2 = loc2
+
 let extract_ltac_trace trace eloc =
   let trace = skip_extensions trace in
   let (loc,c),tail = List.sep_last trace in
@@ -388,18 +394,22 @@ let extract_ltac_trace trace eloc =
     (* We entered a user-defined tactic,
        we display the trace with location of the call *)
     let msg = hov 0 (explain_ltac_call_trace c tail eloc ++ fnl()) in
-    Some msg, loc
+    Some msg, if finer_loc eloc loc then eloc else loc
   else
     (* We entered a primitive tactic, we don't display trace but
        report on the finest location *)
     let best_loc =
-      if not (Loc.is_ghost eloc) then eloc else
-        (* trace is with innermost call coming first *)
-        let rec aux = function
-        | (loc,_)::tail when not (Loc.is_ghost loc) -> loc
-        | _::tail -> aux tail
-        | [] -> Loc.ghost in
-        aux trace in
+      (* trace is with innermost call coming first *)
+      let rec aux best_loc = function
+        | (loc,_)::tail ->
+           if Loc.is_ghost best_loc ||
+              not (Loc.is_ghost loc) && finer_loc loc best_loc
+           then
+             aux loc tail
+           else
+             aux best_loc tail
+        | [] -> best_loc in
+        aux eloc trace in
     None, best_loc
 
 let get_ltac_trace (_, info) =
@@ -409,4 +419,4 @@ let get_ltac_trace (_, info) =
   | None -> None
   | Some trace -> Some (extract_ltac_trace trace loc)
 
-let () = Cerrors.register_additional_error_info get_ltac_trace
+let () = ExplainErr.register_additional_error_info get_ltac_trace
diff --git a/tactics/tactic_matching.ml b/ltac/tactic_matching.ml
index 2144b75e7..ef45ee47e 100644
--- a/tactics/tactic_matching.ml
+++ b/ltac/tactic_matching.ml
@@ -13,6 +13,8 @@ open Names
 open Tacexpr
 open Context.Named.Declaration
 
+module NamedDecl = Context.Named.Declaration
+
 (** [t] is the type of matching successes. It ultimately contains a
     {!Tacexpr.glob_tactic_expr} representing the left-hand side of the
     corresponding matching rule, a matching substitution to be
@@ -103,7 +105,7 @@ let verify_metas_coherence env sigma (ln1,lcm) (ln,lm) =
   (merged, Id.Map.merge merge lcm lm)
 
 let matching_error =
-  Errors.UserError ("tactic matching" , Pp.str "No matching clauses for match.")
+  CErrors.UserError (Some "tactic matching" , Pp.str "No matching clauses for match.")
 
 let imatching_error = (matching_error, Exninfo.null)
 
@@ -280,9 +282,9 @@ module PatternMatching (E:StaticEnvironment) = struct
       the name of the matched hypothesis. *)
   let hyp_match_type hypname pat hyps =
     pick hyps >>= fun decl ->
-    let id = get_id decl in
+    let id = NamedDecl.get_id decl in
     let refresh = is_local_def decl in
-    pattern_match_term refresh pat (get_type decl) () <*>
+    pattern_match_term refresh pat (NamedDecl.get_type decl) () <*>
     put_terms (id_map_try_add_name hypname (Term.mkVar id) empty_term_subst) <*>
     return id
 
@@ -319,7 +321,7 @@ module PatternMatching (E:StaticEnvironment) = struct
         (* spiwack: alternatively it is possible to return the list
            with the matched hypothesis removed directly in
            [hyp_match]. *)
-        let select_matched_hyp decl = Id.equal (get_id decl) matched_hyp in
+        let select_matched_hyp decl = Id.equal (NamedDecl.get_id decl) matched_hyp in
         let hyps = CList.remove_first select_matched_hyp hyps in
         hyp_pattern_list_match pats hyps lhs
     | [] -> return lhs
diff --git a/tactics/tactic_matching.mli b/ltac/tactic_matching.mli
index 090207bcc..090207bcc 100644
--- a/tactics/tactic_matching.mli
+++ b/ltac/tactic_matching.mli
diff --git a/ltac/tauto.ml b/ltac/tauto.ml
index c0cae84c0..756958c2f 100644
--- a/ltac/tauto.ml
+++ b/ltac/tauto.ml
@@ -96,7 +96,7 @@ let intro = Tactics.intro
 let assert_ ?by c =
   let tac = match by with
   | None -> None
-  | Some tac -> Some (tclCOMPLETE tac)
+  | Some tac -> Some (Some tac)
   in
   Proofview.tclINDEPENDENT (Tactics.forward true tac None c)
 
diff --git a/myocamlbuild.ml b/myocamlbuild.ml
deleted file mode 100644
index 90df4f00c..000000000
--- a/myocamlbuild.ml
+++ /dev/null
@@ -1,483 +0,0 @@
-(** * Plugin for building Coq via Ocamlbuild *)
-
-open Ocamlbuild_plugin
-open Ocamlbuild_pack
-open Printf
-open Scanf
-
-(** WARNING !! this is preliminary stuff. It should allows you to
-    build coq and its libraries if everything goes right.
-    Support for all the build rules and configuration options
-    is progressively added. Tested only on linux + ocaml 3.11 +
-    local + natdynlink for now.
-
-    Usage:
-     ./configure -local -opt
-     ./build   (which launches ocamlbuild coq.otarget)
-
-    Then you can (hopefully) launch bin/coqtop, bin/coqide and so on.
-    Apart from the links in bin, every created files are in _build.
-    A "./build clean" should give you back a clean source tree
-
-*)
-
-(** F.A.Q about ocamlbuild:
-
-* P / Px ?
-
- Same, except that the second can be use to signal the main target
- of a rule, in order to get a nicer log (otherwise the full command
- is used as target name)
-
-*)
-
-
-
-(** Generic file reader, which produces a list of strings, one per line *)
-
-let read_file f =
-  let ic = open_in f and l = ref [] in
-  (try while true do l := (input_line ic)::!l done with End_of_file -> ());
-  close_in ic; List.rev !l
-
-
-(** Configuration *)
-
-(** First, we access coq_config.ml indirectly : we symlink it to
-    myocamlbuild_config.ml, which is linked with this myocamlbuild.ml *)
-
-module Coq_config = struct include Myocamlbuild_config end
-
-let _ = begin
-  Options.ocamlc := A Coq_config.ocamlc;
-  Options.ocamlopt := A Coq_config.ocamlopt;
-  Options.ocamlmklib := A Coq_config.ocamlmklib;
-  Options.ocamldep := A Coq_config.ocamldep;
-  Options.ocamldoc := A Coq_config.ocamldoc;
-  Options.ocamlyacc := A Coq_config.ocamlyacc;
-  Options.ocamllex := A Coq_config.ocamllex;
-end
-
-let w32 = Coq_config.arch_is_win32
-
-let w32pref = "i586-mingw32msvc"
-let w32ocamlc = w32pref^"-ocamlc"
-let w32ocamlopt = w32pref^"-ocamlopt"
-let w32ocamlmklib = w32pref^"-ocamlmklib"
-let w32res = w32pref^"-windres"
-let w32lib = "/usr/"^w32pref^"/lib/"
-let w32bin = "/usr/"^w32pref^"/bin/"
-let w32ico = "ide/coq_icon.o"
-
-let _ = if w32 then begin
-  Options.ocamlopt := A w32ocamlopt;
-  Options.ocamlmklib := A w32ocamlmklib;
-end
-
-let use_camlp5 = (Coq_config.camlp4 = "camlp5")
-
-let camlp4args =
-  if use_camlp5 then [A "pa_extend.cmo";A "q_MLast.cmo";A "pa_macro.cmo"]
-  else []
-
-let ocaml = A Coq_config.ocaml
-let camlp4o = S ((A Coq_config.camlp4o) :: camlp4args)
-let camlp4incl = S[A"-I"; A Coq_config.camlp4lib]
-let camlp4compat = Sh Coq_config.camlp4compat
-let opt = (Coq_config.best = "opt")
-let ide = Coq_config.has_coqide
-let hasdynlink = Coq_config.has_natdynlink
-let os5fix = (Coq_config.natdynlinkflag = "os5fixme")
-let dep_dynlink = if hasdynlink then N else Sh"-natdynlink no"
-let lablgtkincl = Sh Coq_config.coqideincl
-let local = Coq_config.local
-let cflags = S[A"-ccopt";A Coq_config.cflags]
-
-(** Do we want to inspect .ml generated from .ml4 ? *)
-let readable_genml = false
-let readable_flag = if readable_genml then A"pr_o.cmo" else N
-
-let _build = Options.build_dir
-
-
-(** Abbreviations about files *)
-
-let core_libs =
-  ["lib/clib"; "lib/lib"; "kernel/kernel"; "library/library";
-   "engine/engine"; "pretyping/pretyping"; "interp/interp";  "proofs/proofs";
-   "parsing/parsing"; "printing/printing"; "tactics/tactics";
-   "stm/stm"; "toplevel/toplevel";  "parsing/highparsing";
-   "ltac/ltac"]
-let core_cma = List.map (fun s -> s^".cma") core_libs
-let core_cmxa = List.map (fun s -> s^".cmxa") core_libs
-let core_mllib = List.map (fun s -> s^".mllib") core_libs
-
-let tolink = "tools/tolink.ml"
-
-let c_headers_base =
-  ["coq_fix_code.h";"coq_instruct.h"; "coq_memory.h";
-   "coq_gc.h"; "coq_interp.h"; "coq_values.h";
-   "coq_jumptbl.h"]
-let c_headers = List.map ((^) "kernel/byterun/") c_headers_base
-
-let coqinstrs = "kernel/byterun/coq_instruct.h"
-let coqjumps = "kernel/byterun/coq_jumptbl.h"
-let copcodes = "kernel/copcodes.ml"
-
-let libcoqrun = "kernel/byterun/libcoqrun.a"
-
-let init_vo = "theories/Init/Prelude.vo"
-
-let nmake = "theories/Numbers/Natural/BigN/NMake_gen.v"
-let nmakegen = "theories/Numbers/Natural/BigN/NMake_gen.ml"
-
-let adapt_name (pref,oldsuf,newsuf) f =
- pref ^ (Filename.chop_suffix f oldsuf) ^ newsuf
-
-let get_names (oldsuf,newsuf) s =
-  let pref = Filename.dirname s ^ "/" in
-  List.map (adapt_name (pref,oldsuf,newsuf)) (string_list_of_file s)
-
-let get_vo_itargets f =
-  let vo_itargets = get_names (".otarget",".itarget") f in
-  List.flatten (List.map (get_names (".vo",".v")) vo_itargets)
-
-let theoriesv = get_vo_itargets "theories/theories.itarget"
-
-let pluginsv = get_vo_itargets "plugins/pluginsvo.itarget"
-
-let pluginsmllib = get_names (".cma",".mllib") "plugins/pluginsbyte.itarget"
-
-(** for correct execution of coqdep_boot, source files should have
-    been imported in _build (and NMake_gen.v should have been created). *)
-
-let coqdepdeps = theoriesv @ pluginsv @ pluginsmllib
-
-let coqtop = "toplevel/coqtop"
-let coqide = "ide/coqide"
-let coqdepboot = "tools/coqdep_boot"
-let coqmktop = "tools/coqmktop"
-
-(** The list of binaries to build:
-    (name of link in bin/, name in _build, install both or only best) *)
-
-type links = Both | Best | BestInPlace | Ide
-
-let all_binaries =
- (if w32 then [ "mkwinapp", "tools/mkwinapp", Best ] else []) @
- [ "coqtop", coqtop, Both;
-   "coqide", "ide/coqide_main", Ide;
-   "coqmktop", coqmktop, Both;
-   "coqc", "tools/coqc", Both;
-   "coqchk", "checker/main", Both;
-   "coqdep_boot", coqdepboot, Best;
-   "coqdep", "tools/coqdep", Best;
-   "coqdoc", "tools/coqdoc/main", Best;
-   "coqwc", "tools/coqwc", Best;
-   "coq_makefile", "tools/coq_makefile", Best;
-   "coq-tex", "tools/coq_tex", Best;
-   "gallina", "tools/gallina", Best;
-   "csdpcert", "plugins/micromega/csdpcert", BestInPlace;
-   "fake_ide", "tools/fake_ide", Best;
- ]
-
-
-let best_oext = if opt then ".native" else ".byte"
-let best_ext = if opt then ".opt" else ".byte"
-let best_iext = if ide = "opt" then ".opt" else ".byte"
-
-let coqtopbest = coqtop^best_oext
-(* For inner needs, we rather use the bytecode versions of coqdep
-   and coqmktop: slightly slower but compile quickly, and ok with
-   w32 cross-compilation *)
-let coqdep_boot = coqdepboot^".byte"
-let coqmktop_boot = coqmktop^".byte"
-
-let binariesopt_deps =
-  let addext b = b ^ ".native" in
-  let rec deps = function
-    | [] -> []
-    | (_,b,Ide)::l -> if ide="opt" then addext b :: deps l else deps l
-    | (_,b,_)::l -> if opt then addext b :: deps l else deps l
-  in deps all_binaries
-
-let binariesbyte_deps =
-  let addext b = b ^ ".byte" in
-  let rec deps = function
-    | [] -> []
-    | (_,b,Ide)::l -> if ide<>"no" then addext b :: deps l else deps l
-    | (_,b,Both)::l -> addext b :: deps l
-    | (_,b,_)::l -> if not opt then addext b :: deps l else deps l
-  in deps all_binaries
-
-let ln_sf toward f =
-  Command.execute ~quiet:true (Cmd (S [A"ln";A"-sf";P toward;P f]))
-
-let rec make_bin_links = function
-  | [] -> ()
-  | (b,ob,kind)::l ->
-      make_bin_links l;
-      let obd = "../"^ !_build^"/"^ob and bd = "bin/"^b in
-      match kind with
-	| Ide when ide <> "no" ->
-	    ln_sf (obd^".byte") (bd^".byte");
-	    if ide = "opt" then ln_sf (obd^".native") (bd^".opt");
-	    ln_sf (b^best_iext) bd
-	| Ide (* when ide = "no" *) -> ()
-	| Both ->
-	    ln_sf (obd^".byte") (bd^".byte");
-	    if opt then ln_sf (obd^".native") (bd^".opt");
-	    ln_sf (b^best_ext) bd
-	| Best -> ln_sf (obd^best_oext) bd
-	| BestInPlace -> ln_sf (b^best_oext) (!_build^"/"^ob)
-
-let incl f = Ocaml_utils.ocaml_include_flags f
-
-let cmd cl = (fun _ _ -> (Cmd (S cl)))
-
-let initial_actions () = begin
-  (** We "pre-create" a few subdirs in _build *)
-  Shell.mkdir_p (!_build^"/dev");
-  Shell.mkdir_p (!_build^"/bin");
-  Shell.mkdir_p (!_build^"/plugins/micromega");
-  make_bin_links all_binaries;
-end
-
-let extra_rules () = begin
-
-(** Virtual target for building all binaries *)
-
-  rule "binariesopt" ~stamp:"binariesopt" ~deps:binariesopt_deps (fun _ _ -> Nop);
-  rule "binariesbyte" ~stamp:"binariesbyte" ~deps:binariesbyte_deps (fun _ _ -> Nop);
-  rule "binaries" ~stamp:"binaries" ~deps:["binariesbyte";"binariesopt"] (fun _ _ -> Nop);
-
-(** We create a special coq_config which mentions _build *)
-
-  rule "coq_config.ml" ~prod:"coq_config.ml" ~dep:"config/coq_config.ml"
-    (fun _ _ ->
-       if w32 then cp "config/coq_config.ml" "coq_config.ml" else
-       let lines = read_file "config/coq_config.ml" in
-       let lines = List.map (fun s -> s^"\n") lines in
-       let line0 = "\n(* Adapted variables for ocamlbuild *)\n" in
-       (* TODO : line2 isn't completely accurate with respect to ./configure:
-	  the case of -local -vmbyteflags foo isn't supported *)
-       let line1 =
-	 "let vmbyteflags = [\"-dllib\";\"-lcoqrun\"]\n"
-       in
-       Echo (lines @ (if local then [line0;line1] else []),
-	     "coq_config.ml"));
-
-(** Camlp4 extensions *)
-
-  rule ".ml4.ml" ~dep:"%.ml4" ~prod:"%.ml"
-    (fun env _ ->
-       let ml4 = env "%.ml4" and ml = env "%.ml" in
-       Cmd (S[camlp4o;T(tags_of_pathname ml4 ++ "p4mod");readable_flag;
-	      T(tags_of_pathname ml4 ++ "p4option"); camlp4compat;
-	      A"-o"; Px ml; A"-impl"; P ml4]));
-
-  flag_and_dep ["p4mod"; "use_grammar"] (P "grammar/grammar.cma");
-  flag_and_dep ["p4mod"; "use_constr"] (P "grammar/q_constr.cmo");
-
-  flag_and_dep ["p4mod"; "use_compat5"] (P "tools/compat5.cmo");
-  flag_and_dep ["p4mod"; "use_compat5b"] (P "tools/compat5b.cmo");
-
-  if w32 then begin
-    flag ["p4mod"] (A "-DWIN32");
-    dep ["ocaml"; "link"; "ide"] ["ide/ide_win32_stubs.o"];
-  end;
-
-  if not use_camlp5 then begin
-  let mlp_cmo s =
-    let src=s^".mlp" and dst=s^".cmo" in
-    rule (src^".cmo") ~dep:src ~prod:dst ~insert:`top
-      (fun env _ ->
-	 Cmd (S [!Options.ocamlc; A"-c"; A"-pp";
-		 Quote (S [camlp4o;A"-impl"]); camlp4incl; A"-impl"; P src]))
-  in
-  mlp_cmo "tools/compat5";
-  mlp_cmo "tools/compat5b";
-  end;
-
-(** All caml files are compiled with +camlp4/5
-    and ide files need +lablgtk2 *)
-
-  flag ["compile"; "ocaml"] (S [A"-thread";A"-rectypes"; camlp4incl]);
-  flag ["link"; "ocaml"] (S [A"-rectypes"; camlp4incl]);
-  flag ["ocaml"; "ide"; "compile"] lablgtkincl;
-  flag ["ocaml"; "ide"; "link"] lablgtkincl;
-  flag ["ocaml"; "ide"; "link"; "byte"]
-    (S [A"lablgtk.cma"; A"lablgtksourceview2.cma"]);
-  flag ["ocaml"; "ide"; "link"; "native"]
-    (S [A"lablgtk.cmxa"; A"lablgtksourceview2.cmxa"]);
-
-(** C code for the VM *)
-
-  dep ["compile"; "c"] c_headers;
-  flag ["compile"; "c"] cflags;
-  dep ["ocaml"; "use_libcoqrun"; "compile"] [libcoqrun];
-  dep ["ocaml"; "use_libcoqrun"; "link"; "native"] [libcoqrun];
-  flag ["ocaml"; "use_libcoqrun"; "link"; "byte"] (Sh Coq_config.vmbyteflags);
-
-  (* we need to use a different ocamlc. For now we copy the rule *)
-  if w32 then
-  rule ".c.o"  ~deps:("%.c"::c_headers) ~prod:"%.o" ~insert:`top
-    (fun env _ ->
-       let c = env "%.c" in
-       let o = env "%.o" in
-       Seq [Cmd (S [P w32ocamlc;cflags;A"-c";Px c]);
-	    mv  (Filename.basename o) o]);
-
-(** VM: Generation of coq_jumbtbl.h and copcodes.ml from coq_instruct.h *)
-
-  rule "coqinstrs" ~dep:coqinstrs ~prods:[coqjumps;copcodes]
-    (fun _ _ ->
-       let jmps = ref [] and ops = ref [] and i = ref 0 in
-       let add_instr instr comma =
-	 if instr = "" then failwith "Empty" else begin
-	   jmps:=sprintf "&&coq_lbl_%s%s \n" instr comma :: !jmps;
-	   ops:=sprintf "let op%s = %d\n" instr !i :: !ops;
-	   incr i
-	 end
-       in
-       (** we recognize comma-separated uppercase instruction names *)
-       let parse_line s =
-	 let b = Scanning.from_string s in
-	 try while true do bscanf b " %[A-Z0-9_]%[,]" add_instr done
-	 with _ -> ()
-       in
-       List.iter parse_line (read_file coqinstrs);
-       Seq [Echo (List.rev !jmps, coqjumps);
-	    Echo (List.rev !ops, copcodes)]);
-
-(** Generation of tolink.ml *)
-
-  rule tolink ~deps:core_mllib ~prod:tolink
-    (fun _ _ ->
-       let cat s = String.concat " " (string_list_of_file s) in
-       let core_mods = String.concat " " (List.map cat core_mllib) in
-       let core_cmas = String.concat " " core_cma in
-       Echo (["let copts = \"-cclib -lcoqrun\"\n";
-	      "let core_libs = \""^core_cmas^"\"\n";
-	      "let core_objs = \""^core_mods^"\"\n"],
-	     tolink));
-
-(** For windows, building coff object file from a .rc (for the icon) *)
-
-  if w32 then rule ".rc.o" ~deps:["%.rc";"ide/coq.ico"] ~prod:"%.o"
-    (fun env _ ->
-       let rc = env "%.rc" and o = env "%.o" in
-       Cmd (S [P w32res;A "--input-format";A "rc";A "--input";P rc;
-	       A "--output-format";A "coff";A "--output"; Px o]));
-
-(** The windows version of Coqide is now a console-free win32 app,
-    which moreover contains the Coq icon. If necessary, the mkwinapp
-    tool can be used later to restore or suppress the console of Coqide. *)
-
-  if w32 then dep ["link"; "ocaml"; "program"; "ide"] [w32ico];
-
-  if w32 then flag ["link"; "ocaml"; "program"; "ide"]
-    (S [A "-ccopt"; A "-link -Wl,-subsystem,windows"; P w32ico]);
-
-(** Coqtop *)
-
-  let () =
-    let fo = coqtop^".native" and fb = coqtop^".byte" in
-    let depsall = (if w32 then [w32ico] else [])@[coqmktop_boot;libcoqrun] in
-    let depso =  core_cmxa in
-    let depsb =  core_cma in
-    let w32flag =
-      if not w32 then N else S ([A"-camlbin";A w32bin;A "-ccopt";P w32ico])
-    in
-    if opt then rule fo ~prod:fo ~deps:(depsall@depso) ~insert:`top
-      (cmd [P coqmktop_boot;w32flag;A"-boot";A"-opt";incl fo;A"-thread";camlp4incl;A"-o";Px fo]);
-    rule fb ~prod:fb ~deps:(depsall@depsb) ~insert:`top
-      (cmd [P coqmktop_boot;w32flag;A"-boot";A"-top";incl fb;A"-thread";camlp4incl;A"-o";Px fb]);
-  in
-
-(** Coq files dependencies *)
-
-  rule "coqdepready" ~stamp:"coqdepready" ~deps:coqdepdeps (fun _ _ -> Nop);
-
-  rule ".v.d" ~prod:"%.v.depends" ~deps:["%.v";coqdep_boot;"coqdepready"]
-    (fun env _ ->
-       let v = env "%.v" and vd = env "%.v.depends" in
-       (** NB: this relies on all .v files being already in _build. *)
-       Cmd (S [P coqdep_boot;dep_dynlink;P v;Sh">";Px vd]));
-
-(** Coq files compilation *)
-
-  let coq_build_dep f build =
-    (** NB: this relies on coqdep producing a single Makefile line
-	for one .v file, with some specific shape "f.vo ...: f.v deps.vo ..." *)
-    let src = f^".v" in
-    let depends = f^".v.depends" in
-    let rec get_deps keep = function
-      | [] -> []
-      | d::deps when d = src -> get_deps keep deps
-      | d::deps when keep -> [d] :: get_deps keep deps
-      | d::deps -> get_deps (String.contains d ':') deps
-    in
-    let d = get_deps false (string_list_of_file depends) in
-    List.iter Outcome.ignore_good (build d)
-
-  in
-
-  let coq_v_rule d init =
-    let bootflag = if init then A"-noinit" else N in
-    let gendep = if init then coqtopbest else init_vo in
-    rule (d^".v.vo")
-      ~prods:[d^"%.vo";d^"%.glob"] ~deps:[gendep;d^"%.v";d^"%.v.depends"]
-      (fun env build ->
-	 let f = env (d^"%") in
-	 coq_build_dep f build;
-	 Cmd (S [P coqtopbest;A"-boot";bootflag;A"-compile";Px f]))
-  in
-  coq_v_rule "theories/Init/" true;
-  coq_v_rule "" false;
-
-(** Generation of _plugin_mod.ml files *)
-
-  rule "_mod.ml" ~prod:"%_plugin_mod.ml" ~dep:"%_plugin.mllib"
-    (fun env _ ->
-       let line s = "let _ = Mltop.add_known_module \""^s^"\"\n" in
-       let mods =
-	 string_list_of_file (env "%_plugin.mllib") @
-	   [Filename.basename (env "%_plugin")]
-       in
-       Echo (List.map line mods, env "%_plugin_mod.ml"));
-
-(** Rule for native dynlinkable plugins *)
-
-  rule ".cmxa.cmxs" ~prod:"%.cmxs" ~dep:"%.cmxa"
-    (fun env _ ->
-       let cmxs = Px (env "%.cmxs") and cmxa = P (env "%.cmxa") in
-       if os5fix then
-	 Cmd (S [A"../dev/ocamlopt_shared_os5fix.sh"; !Options.ocamlopt; cmxs])
-       else
-	 Cmd (S [!Options.ocamlopt;A"-linkall";A"-shared";A"-o";cmxs;cmxa]));
-
-(** Generation of NMake.v from NMake_gen.ml *)
-
-  rule "NMake" ~prod:nmake ~dep:nmakegen
-    (cmd [ocaml;P nmakegen;Sh ">";Px nmake]);
-
-end
-
-(** Registration of our rules (after the standard ones) *)
-
-let _ = dispatch begin function
-  | After_rules -> initial_actions (); extra_rules ()
-  | _ -> ()
-end
-
-(** TODO / Remarques:
-
-    * Apres un premier build, le second prend du temps, meme cached:
-      1 min 25 pour les 2662 targets en cache. Etonnement, refaire
-      coqtop.byte ne prend que ~4s, au lieu des ~40s pour coqtop.opt.
-      A comprendre ...
-
-    * Parallelisation: vraiment pas top
-
-*)
diff --git a/parsing/cLexer.ml4 b/parsing/cLexer.ml4
index 9a7aeaf0c..02a720d2d 100644
--- a/parsing/cLexer.ml4
+++ b/parsing/cLexer.ml4
@@ -9,6 +9,7 @@
 open Pp
 open Util
 open Tok
+open Compat
 
 (* Dictionaries: trees annotated with string options, each node being a map
    from chars to dictionaries (the subtrees). A trie, in other words. *)
@@ -68,6 +69,15 @@ let ttree_remove ttree str =
   in
   remove ttree 0
 
+let ttree_elements ttree =
+  let rec elts tt accu =
+    let accu = match tt.node with
+    | None -> accu
+    | Some s -> CString.Set.add s accu
+    in
+    CharMap.fold (fun _ tt accu -> elts tt accu) tt.branch accu
+  in
+  elts ttree CString.Set.empty
 
 (* Errors occurring while lexing (explained as "Lexer error: ...") *)
 
@@ -80,7 +90,6 @@ module Error = struct
     | Undefined_token
     | Bad_token of string
     | UnsupportedUnicode of int
-    | IncorrectIndex of char list
 
   exception E of t
 
@@ -93,24 +102,15 @@ module Error = struct
          | Undefined_token -> "Undefined token"
          | Bad_token tok -> Format.sprintf "Bad token %S" tok
          | UnsupportedUnicode x ->
-             Printf.sprintf "Unsupported Unicode character (0x%x)" x
-         | IncorrectIndex l ->
-             let l = List.map (fun c -> Char.code c - 48) l in
-             let s = match l with
-             | c::d::l ->
-                 let l = List.map string_of_int (List.rev l) in
-                 String.concat "" l ^ CString.ordinal (10 * d + c)
-             | [c] -> CString.ordinal c
-             | [] -> assert false in
-             Printf.sprintf "%s expected" s)
+             Printf.sprintf "Unsupported Unicode character (0x%x)" x)
 
   (* Require to fix the Camlp4 signature *)
-  let print ppf x = Pp.pp_with ppf (Pp.str (to_string x))
+  let print ppf x = Pp.pp_with ~pp_tag:Ppstyle.pp_tag ppf (Pp.str (to_string x))
 
 end
 open Error
 
-let err loc str = Loc.raise (Loc.make_loc loc) (Error.E str)
+let err loc str = Loc.raise ~loc:(Compat.to_coqloc loc) (Error.E str)
 
 let bad_token str = raise (Error.E (Bad_token str))
 
@@ -121,64 +121,61 @@ type token_kind =
   | AsciiChar
   | EmptyStream
 
-let error_unsupported_unicode_character n unicode cs =
-  let bp = Stream.count cs in
-  err (bp,bp+n) (UnsupportedUnicode unicode)
-
-let error_utf8 cs =
+let error_utf8 loc cs =
   let bp = Stream.count cs in
   Stream.junk cs; (* consume the char to avoid read it and fail again *)
-  err (bp, bp+1) Illegal_character
+  let loc = set_loc_pos loc bp (bp+1) in
+  err loc Illegal_character
 
-let utf8_char_size cs = function
+let utf8_char_size loc cs = function
   (* Utf8 leading byte *)
   | '\x00'..'\x7F' -> 1
   | '\xC0'..'\xDF' -> 2
   | '\xE0'..'\xEF' -> 3
   | '\xF0'..'\xF7' -> 4
-  | _ (* '\x80'..\xBF'|'\xF8'..'\xFF' *) -> error_utf8 cs
+  | _ (* '\x80'..\xBF'|'\xF8'..'\xFF' *) -> error_utf8 loc cs
 
 let njunk n = Util.repeat n Stream.junk
 
-let check_utf8_trailing_byte cs c =
-  if not (Int.equal (Char.code c land 0xC0) 0x80) then error_utf8 cs
+let check_utf8_trailing_byte loc cs c =
+  if not (Int.equal (Char.code c land 0xC0) 0x80) then error_utf8 loc cs
 
 (* Recognize utf8 blocks (of length less than 4 bytes) *)
 (* but don't certify full utf8 compliance (e.g. no emptyness check) *)
-let lookup_utf8_tail c cs =
+let lookup_utf8_tail loc c cs =
   let c1 = Char.code c in
-  if Int.equal (c1 land 0x40) 0 || Int.equal (c1 land 0x38) 0x38 then error_utf8 cs
+  if Int.equal (c1 land 0x40) 0 || Int.equal (c1 land 0x38) 0x38 then error_utf8 loc cs
   else
     let n, unicode =
       if Int.equal (c1 land 0x20) 0 then
       match Stream.npeek 2 cs with
       | [_;c2] ->
-          check_utf8_trailing_byte cs c2;
+          check_utf8_trailing_byte loc cs c2;
           2, (c1 land 0x1F) lsl 6 + (Char.code c2 land 0x3F)
-      | _ -> error_utf8 cs
+      | _ -> error_utf8 loc cs
       else if Int.equal (c1 land 0x10) 0 then
       match Stream.npeek 3 cs with
       | [_;c2;c3] ->
-          check_utf8_trailing_byte cs c2; check_utf8_trailing_byte cs c3;
+          check_utf8_trailing_byte loc cs c2;
+	  check_utf8_trailing_byte loc cs c3;
           3, (c1 land 0x0F) lsl 12 + (Char.code c2 land 0x3F) lsl 6 +
           (Char.code c3 land 0x3F)
-      | _ -> error_utf8 cs
+      | _ -> error_utf8 loc cs
       else match Stream.npeek 4 cs with
       | [_;c2;c3;c4] ->
-          check_utf8_trailing_byte cs c2; check_utf8_trailing_byte cs c3;
-          check_utf8_trailing_byte cs c4;
+          check_utf8_trailing_byte loc cs c2;
+	  check_utf8_trailing_byte loc cs c3;
+          check_utf8_trailing_byte loc cs c4;
           4, (c1 land 0x07) lsl 18 + (Char.code c2 land 0x3F) lsl 12 +
           (Char.code c3 land 0x3F) lsl 6 + (Char.code c4 land 0x3F)
-      | _ -> error_utf8 cs
+      | _ -> error_utf8 loc cs
     in
-    try Unicode.classify unicode, n
-    with Unicode.Unsupported ->
-      njunk n cs; error_unsupported_unicode_character n unicode cs
+    Utf8Token (Unicode.classify unicode, n)
 
-let lookup_utf8 cs =
+let lookup_utf8 loc cs =
   match Stream.peek cs with
     | Some ('\x00'..'\x7F') -> AsciiChar
-    | Some ('\x80'..'\xFF' as c) -> Utf8Token (lookup_utf8_tail c cs)
+    | Some ('\x80'..'\xFF' as c) -> lookup_utf8_tail loc c cs
     | None -> EmptyStream
 
 let unlocated f x = f x
@@ -189,20 +186,13 @@ let check_keyword str =
   let rec loop_symb = parser
     | [< ' (' ' | '\n' | '\r' | '\t' | '"') >] -> bad_token str
     | [< s >] ->
-        match unlocated lookup_utf8 s with
+        match unlocated lookup_utf8 Compat.CompatLoc.ghost s with
         | Utf8Token (_,n) -> njunk n s; loop_symb s
         | AsciiChar -> Stream.junk s; loop_symb s
         | EmptyStream -> ()
   in
   loop_symb (Stream.of_string str)
 
-let check_keyword_to_add s =
-  try check_keyword s
-  with Error.E (UnsupportedUnicode unicode) ->
-    Flags.if_verbose Feedback.msg_warning
-      (strbrk (Printf.sprintf "Token '%s' contains unicode character 0x%x \
-                               which will not be parsable." s unicode))
-
 let check_ident str =
   let rec loop_id intail = parser
     | [< ' ('a'..'z' | 'A'..'Z' | '_'); s >] ->
@@ -210,7 +200,7 @@ let check_ident str =
     | [< ' ('0'..'9' | ''') when intail; s >] ->
         loop_id true s
     | [< s >] ->
-        match unlocated lookup_utf8 s with
+        match unlocated lookup_utf8 Compat.CompatLoc.ghost s with
         | Utf8Token (Unicode.Letter, n) -> njunk n s; loop_id true s
         | Utf8Token (Unicode.IdentPart, n) when intail ->
           njunk n s;
@@ -233,13 +223,15 @@ let is_keyword s =
 let add_keyword str =
   if not (is_keyword str) then
     begin
-      check_keyword_to_add str;
+      check_keyword str;
       token_tree := ttree_add !token_tree str
     end
 
 let remove_keyword str =
   token_tree := ttree_remove !token_tree str
 
+let keywords () = ttree_elements !token_tree
+
 (* Freeze and unfreeze the state of the lexer *)
 type frozen_t = ttree
 
@@ -263,116 +255,133 @@ let get_buff len = String.sub !buff 0 len
 
 (* The classical lexer: idents, numbers, quoted strings, comments *)
 
-let rec ident_tail len = parser
+let warn_unrecognized_unicode =
+  CWarnings.create ~name:"unrecognized-unicode" ~category:"parsing"
+         (fun (u,id) ->
+          strbrk (Printf.sprintf "Not considering unicode character \"%s\" of unknown \
+                                  lexical status as part of identifier \"%s\"." u id))
+
+let rec ident_tail loc len = parser
   | [< ' ('a'..'z' | 'A'..'Z' | '0'..'9' | ''' | '_' as c); s >] ->
-      ident_tail (store len c) s
+      ident_tail loc (store len c) s
   | [< s >] ->
-      match lookup_utf8 s with
+      match lookup_utf8 loc s with
       | Utf8Token ((Unicode.IdentPart | Unicode.Letter), n) ->
-          ident_tail (nstore n len s) s
+          ident_tail loc (nstore n len s) s
+      | Utf8Token (Unicode.Unknown, n) ->
+          let id = get_buff len in
+          let u = String.concat "" (List.map (String.make 1) (Stream.npeek n s)) in
+          warn_unrecognized_unicode ~loc:!@loc (u,id); len
       | _ -> len
 
-let check_no_char s =
-  match Stream.npeek 3 s with
-  | [_;_;('a'..'z' | 'A'..'Z' | '0'..'9' | ''' | '_')] -> false
-  | [_;_;_] -> true
-  | [_;_] -> true
-  | _ -> assert false
-
-let is_teen = function
-  | _::'1'::l -> true
-  | _ -> false
-
-let is_gt3 = function
-  | c::_ when c == '1' || c == '2' || c == '3' -> false
-  | _ -> true
-
-let check_gt3 l loc len =
-  if not (l == ['0']) && (is_teen l || is_gt3 l) then (false, len)
-  else err loc (IncorrectIndex l)
-
-let check_n n l loc len =
-  if List.hd l == n && not (is_teen l) then (false, len)
-  else err loc (IncorrectIndex l)
-
-let rec number_or_index bp l len = parser
-  | [< ' ('0'..'9' as c); s >] -> number_or_index bp (c::l) (store len c) s
-  | [< s >] ep ->
-      match Stream.npeek 2 s with
-      | ['s';'t'] when check_no_char s -> njunk 2 s; check_n '1' l (bp,ep) len
-      | ['n';'d'] when check_no_char s -> njunk 2 s; check_n '2' l (bp,ep) len
-      | ['r';'d'] when check_no_char s -> njunk 2 s; check_n '3' l (bp,ep) len
-      | ['t';'h'] when check_no_char s -> njunk 2 s; check_gt3 l (bp,ep) len
-      | _ -> true, len
-
-let rec string in_comments bp len = parser
+let rec number len = parser
+  | [< ' ('0'..'9' as c); s >] -> number (store len c) s
+  | [< >] -> len
+
+let warn_comment_terminator_in_string =
+  CWarnings.create ~name:"comment-terminator-in-string" ~category:"parsing"
+         (fun () ->
+          (strbrk
+             "Not interpreting \"*)\" as the end of current \
+              non-terminated comment because it occurs in a \
+              non-terminated string of the comment."))
+
+(* If the string being lexed is in a comment, [comm_level] is Some i with i the
+   current level of comments nesting. Otherwise, [comm_level] is None. *)
+let rec string loc ~comm_level bp len = parser
   | [< ''"'; esc=(parser [<''"' >] -> true | [< >] -> false); s >] ->
-      if esc then string in_comments bp (store len '"') s else len
+      if esc then string loc ~comm_level bp (store len '"') s else (loc, len)
   | [< ''('; s >] ->
       (parser
         | [< ''*'; s >] ->
-            string
-              (Option.map succ in_comments)
+            string loc
+              (Option.map succ comm_level)
               bp (store (store len '(') '*')
               s
         | [< >] ->
-            string in_comments bp (store len '(') s) s
+            string loc comm_level bp (store len '(') s) s
   | [< ''*'; s >] ->
       (parser
         | [< '')'; s >] ->
-            let () = match in_comments with
+            let () = match comm_level with
             | Some 0 ->
-                Feedback.msg_warning
-                  (strbrk
-                     "Not interpreting \"*)\" as the end of current \
-                      non-terminated comment because it occurs in a \
-                      non-terminated string of the comment.")
+	       warn_comment_terminator_in_string ~loc:!@loc ()
             | _ -> ()
             in
-            let in_comments = Option.map pred in_comments in
-            string in_comments bp (store (store len '*') ')') s
+            let comm_level = Option.map pred comm_level in
+            string loc comm_level bp (store (store len '*') ')') s
         | [< >] ->
-            string in_comments bp (store len '*') s) s
-  | [< 'c; s >] -> string in_comments bp (store len c) s
-  | [< _ = Stream.empty >] ep -> err (bp, ep) Unterminated_string
+            string loc comm_level bp (store len '*') s) s
+  | [< ''\n' as c; s >] ep ->
+     (* If we are parsing a comment, the string if not part of a token so we
+     update the first line of the location. Otherwise, we update the last
+     line. *)
+     let loc =
+       if Option.has_some comm_level then bump_loc_line loc ep
+       else bump_loc_line_last loc ep
+     in
+     string loc comm_level bp (store len c) s
+  | [< 'c; s >] -> string loc comm_level bp (store len c) s
+  | [< _ = Stream.empty >] ep ->
+     let loc = set_loc_pos loc bp ep in
+     err loc Unterminated_string
 
 (* Hook for exporting comment into xml theory files *)
 let (f_xml_output_comment, xml_output_comment) = Hook.make ~default:ignore ()
 
+(* To associate locations to a file name *)
+let current_file = ref None
+
 (* Utilities for comments in beautify *)
 let comment_begin = ref None
 let comm_loc bp = match !comment_begin with
 | None -> comment_begin := Some bp
 | _ -> ()
 
-let current = Buffer.create 8192
-let between_com = ref true
+let comments = ref []
+let current_comment = Buffer.create 8192
+let between_commands = ref true
+
+let rec split_comments comacc acc pos = function
+    [] -> comments := List.rev acc; comacc
+  | ((b,e),c as com)::coms ->
+      (* Take all comments that terminates before pos, or begin exactly
+         at pos (used to print comments attached after an expression) *)
+      if e<=pos || pos=b then split_comments (c::comacc) acc pos coms
+      else split_comments comacc (com::acc) pos coms
 
-type com_state = int option * string * bool
-let restore_com_state (o,s,b) =
+let extract_comments pos = split_comments [] [] pos !comments
+
+(* The state of the lexer visible from outside *)
+type lexer_state = int option * string * bool * ((int * int) * string) list * string option
+
+let init_lexer_state f = (None,"",true,[],f)
+let set_lexer_state (o,s,b,c,f) =
   comment_begin := o;
-  Buffer.clear current; Buffer.add_string current s;
-  between_com := b
-let dflt_com = (None,"",true)
-let com_state () =
-  let s = (!comment_begin, Buffer.contents current, !between_com) in
-  restore_com_state dflt_com; s
+  Buffer.clear current_comment; Buffer.add_string current_comment s;
+  between_commands := b;
+  comments := c;
+  current_file := f
+let release_lexer_state () =
+  (!comment_begin, Buffer.contents current_comment, !between_commands, !comments, !current_file)
+let drop_lexer_state () =
+    set_lexer_state (init_lexer_state None)
 
-let real_push_char c = Buffer.add_char current c
+let real_push_char c = Buffer.add_char current_comment c
 
 (* Add a char if it is between two commands, if it is a newline or
    if the last char is not a space itself. *)
 let push_char c =
   if
-    !between_com || List.mem c ['\n';'\r'] ||
+    !between_commands || List.mem c ['\n';'\r'] ||
     (List.mem c [' ';'\t']&&
-     (Int.equal (Buffer.length current) 0 ||
-      not (let s = Buffer.contents current in
+     (Int.equal (Buffer.length current_comment) 0 ||
+      not (let s = Buffer.contents current_comment in
            List.mem s.[String.length s - 1] [' ';'\t';'\n';'\r'])))
   then
     real_push_char c
 
-let push_string s = Buffer.add_string current s
+let push_string s = Buffer.add_string current_comment s
 
 let null_comment s =
   let rec null i =
@@ -380,12 +389,12 @@ let null_comment s =
   null (String.length s - 1)
 
 let comment_stop ep =
-  let current_s = Buffer.contents current in
-  if !Flags.xml_export && Buffer.length current > 0 &&
-    (!between_com || not(null_comment current_s)) then
+  let current_s = Buffer.contents current_comment in
+  if !Flags.xml_export && Buffer.length current_comment > 0 &&
+    (!between_commands || not(null_comment current_s)) then
       Hook.get f_xml_output_comment current_s;
-  (if Flags.do_beautify() && Buffer.length current > 0 &&
-    (!between_com || not(null_comment current_s)) then
+  (if !Flags.beautify && Buffer.length current_comment > 0 &&
+    (!between_commands || not(null_comment current_s)) then
     let bp = match !comment_begin with
         Some bp -> bp
       | None ->
@@ -394,132 +403,120 @@ let comment_stop ep =
              ++ str current_s ++str"' ending at  "
              ++ int ep);
           ep-1 in
-    Pp.comments := ((bp,ep),current_s) :: !Pp.comments);
-  Buffer.clear current;
+    comments := ((bp,ep),current_s) :: !comments);
+  Buffer.clear current_comment;
   comment_begin := None;
-  between_com := false
-
-(* Does not unescape!!! *)
-let rec comm_string bp = parser
-  | [< ''"' >] -> push_string "\""
-  | [< ''\\'; _ =
-           (parser [< ' ('"' | '\\' as c) >] ->
-              let () = match c with
-              | '"' -> real_push_char c
-              | _ -> ()
-              in
-              real_push_char c
-                 | [< >] -> real_push_char '\\'); s >]
-     -> comm_string bp s
-  | [< _ = Stream.empty >] ep -> err (bp, ep) Unterminated_string
-  | [< 'c; s >] -> real_push_char c; comm_string bp s
-
-let rec comment bp = parser bp2
+  between_commands := false
+
+let rec comment loc bp = parser bp2
   | [< ''(';
-       _ = (parser
-              | [< ''*'; s >] -> push_string "(*"; comment bp s
-              | [< >] -> push_string "(" );
-       s >] -> comment bp s
+       loc = (parser
+              | [< ''*'; s >] -> push_string "(*"; comment loc bp s
+              | [< >] -> push_string "("; loc );
+       s >] -> comment loc bp s
   | [< ''*';
-       _ = parser
-         | [< '')' >] -> push_string "*)";
-         | [< s >] -> real_push_char '*'; comment bp s >] -> ()
+       loc = parser
+         | [< '')' >] -> push_string "*)"; loc
+         | [< s >] -> real_push_char '*'; comment loc bp s >] -> loc
   | [< ''"'; s >] ->
-      if Flags.do_beautify() then (push_string"\"";comm_string bp2 s)
-      else ignore (string (Some 0) bp2 0 s);
-      comment bp s
-  | [< _ = Stream.empty >] ep -> err (bp, ep) Unterminated_comment
-  | [< 'z; s >] -> real_push_char z; comment bp s
+      let loc, len = string loc ~comm_level:(Some 0) bp2 0 s in
+      push_string "\""; push_string (get_buff len); push_string "\"";
+      comment loc bp s
+  | [< _ = Stream.empty >] ep ->
+      let loc = set_loc_pos loc bp ep in
+      err loc Unterminated_comment
+  | [< ''\n' as z; s >] ep -> real_push_char z; comment (bump_loc_line loc ep) bp s
+  | [< 'z; s >] -> real_push_char z; comment loc bp s
 
 (* Parse a special token, using the [token_tree] *)
 
 (* Peek as much utf-8 lexemes as possible *)
 (* and retain the longest valid special token obtained *)
-let rec progress_further last nj tt cs =
-  try progress_from_byte last nj tt cs (List.nth (Stream.npeek (nj+1) cs) nj)
+let rec progress_further loc last nj tt cs =
+  try progress_from_byte loc last nj tt cs (List.nth (Stream.npeek (nj+1) cs) nj)
   with Failure _ -> last
 
-and update_longest_valid_token last nj tt cs =
+and update_longest_valid_token loc last nj tt cs =
   match tt.node with
   | Some _ as last' ->
     stream_njunk nj cs;
-    progress_further last' 0 tt cs
+    progress_further loc last' 0 tt cs
   | None ->
-    progress_further last nj tt cs
+    progress_further loc last nj tt cs
 
 (* nj is the number of char peeked since last valid token *)
 (* n the number of char in utf8 block *)
-and progress_utf8 last nj n c tt cs =
+and progress_utf8 loc last nj n c tt cs =
   try
     let tt = CharMap.find c tt.branch in
     if Int.equal n 1 then
-      update_longest_valid_token last (nj+n) tt cs
+      update_longest_valid_token loc last (nj+n) tt cs
     else
       match Util.List.skipn (nj+1) (Stream.npeek (nj+n) cs) with
       | l when Int.equal (List.length l) (n - 1) ->
-         List.iter (check_utf8_trailing_byte cs) l;
+         List.iter (check_utf8_trailing_byte loc cs) l;
          let tt = List.fold_left (fun tt c -> CharMap.find c tt.branch) tt l in
-         update_longest_valid_token last (nj+n) tt cs
+         update_longest_valid_token loc last (nj+n) tt cs
       | _ ->
-          error_utf8 cs
+          error_utf8 loc cs
   with Not_found ->
     last
 
-and progress_from_byte last nj tt cs c =
-  progress_utf8 last nj (utf8_char_size cs c) c tt cs
+and progress_from_byte loc last nj tt cs c =
+  progress_utf8 loc last nj (utf8_char_size loc cs c) c tt cs
 
-let find_keyword id s =
+let find_keyword loc id s =
   let tt = ttree_find !token_tree id in
-  match progress_further tt.node 0 tt s with
+  match progress_further loc tt.node 0 tt s with
   | None -> raise Not_found
   | Some c -> KEYWORD c
 
-let process_sequence bp c cs =
+let process_sequence loc bp c cs =
   let rec aux n cs =
     match Stream.peek cs with
     | Some c' when c == c' -> Stream.junk cs; aux (n+1) cs
-    | _ -> BULLET (String.make n c), (bp, Stream.count cs)
+    | _ -> BULLET (String.make n c), set_loc_pos loc bp (Stream.count cs)
   in
   aux 1 cs
 
 (* Must be a special token *)
-let process_chars bp c cs =
-  let t = progress_from_byte None (-1) !token_tree cs c in
+let process_chars loc bp c cs =
+  let t = progress_from_byte loc None (-1) !token_tree cs c in
   let ep = Stream.count cs in
   match t with
-    | Some t -> (KEYWORD t, (bp, ep))
+    | Some t -> (KEYWORD t, set_loc_pos loc bp ep)
     | None ->
-        let ep' = bp + utf8_char_size cs c in
+        let ep' = bp + utf8_char_size loc cs c in
         njunk (ep' - ep) cs;
-        err (bp, ep') Undefined_token
-
-let token_of_special c s = match c with
-  | '.' -> FIELD s
-  | _ -> assert false
+	let loc = set_loc_pos loc bp ep' in
+        err loc Undefined_token
 
-(* Parse what follows a dot / a dollar *)
+(* Parse what follows a dot *)
 
-let parse_after_special c bp =
+let parse_after_dot loc c bp =
   parser
-  | [< ' ('a'..'z' | 'A'..'Z' | '_' as d); len = ident_tail (store 0 d) >] ->
-      token_of_special c (get_buff len)
+  | [< ' ('a'..'z' | 'A'..'Z' | '_' as d); len = ident_tail loc (store 0 d); s >] ->
+      let field = get_buff len in
+      (try find_keyword loc ("."^field) s with Not_found -> FIELD field)
   | [< s >] ->
-      match lookup_utf8 s with
+      match lookup_utf8 loc s with
       | Utf8Token (Unicode.Letter, n) ->
-          token_of_special c (get_buff (ident_tail (nstore n 0 s) s))
-      | AsciiChar | Utf8Token _ | EmptyStream -> fst (process_chars bp c s)
+          let len = ident_tail loc (nstore n 0 s) s in
+          let field = get_buff len in
+          (try find_keyword loc ("."^field) s with Not_found -> FIELD field)
+      | AsciiChar | Utf8Token _ | EmptyStream -> fst (process_chars loc bp c s)
 
 (* Parse what follows a question mark *)
 
-let parse_after_qmark bp s =
+let parse_after_qmark loc bp s =
   match Stream.peek s with
     | Some ('a'..'z' | 'A'..'Z' | '_') -> LEFTQMARK
     | None -> KEYWORD "?"
     | _ ->
-        match lookup_utf8 s with
+        match lookup_utf8 loc s with
           | Utf8Token (Unicode.Letter, _) -> LEFTQMARK
           | AsciiChar | Utf8Token _ | EmptyStream ->
-            fst (process_chars bp '?' s)
+            fst (process_chars loc bp '?' s)
 
 let blank_or_eof cs =
   match Stream.peek cs with
@@ -529,69 +526,76 @@ let blank_or_eof cs =
 
 (* Parse a token in a char stream *)
 
-let rec next_token = parser bp
-  | [< '' ' | '\t' | '\n' |'\r' as c; s >] ->
-      comm_loc bp; push_char c; next_token s
-  | [< ''.' as c; t = parse_after_special c bp; s >] ep ->
+let rec next_token loc = parser bp
+  | [< ''\n' as c; s >] ep ->
+      comm_loc bp; push_char c; next_token (bump_loc_line loc ep) s
+  | [< '' ' | '\t' | '\r' as c; s >] ->
+      comm_loc bp; push_char c; next_token loc s
+  | [< ''.' as c; t = parse_after_dot loc c bp; s >] ep ->
       comment_stop bp;
       (* We enforce that "." should either be part of a larger keyword,
          for instance ".(", or followed by a blank or eof. *)
       let () = match t with
       | KEYWORD ("." | "...") ->
-        if not (blank_or_eof s) then err (bp,ep+1) Undefined_token;
-        between_com := true;
+        if not (blank_or_eof s) then
+	  err (set_loc_pos loc bp (ep+1)) Undefined_token;
+	between_commands := true;
       | _ -> ()
       in
-      (t, (bp,ep))
+      (t, set_loc_pos loc bp ep)
   | [< ' ('-'|'+'|'*' as c); s >] ->
-      let t,new_between_com =
-        if !between_com then process_sequence bp c s,true
-        else process_chars bp c s,false
+      let t,new_between_commands =
+        if !between_commands then process_sequence loc bp c s, true
+        else process_chars loc bp c s,false
       in
-      comment_stop bp; between_com := new_between_com; t
+      comment_stop bp; between_commands := new_between_commands; t
   | [< ''?'; s >] ep ->
-      let t = parse_after_qmark bp s in comment_stop bp; (t, (ep, bp))
+      let t = parse_after_qmark loc bp s in
+      comment_stop bp; (t, set_loc_pos loc bp ep)
   | [< ' ('a'..'z' | 'A'..'Z' | '_' as c);
-       len = ident_tail (store 0 c); s >] ep ->
+       len = ident_tail loc (store 0 c); s >] ep ->
       let id = get_buff len in
       comment_stop bp;
-      (try find_keyword id s with Not_found -> IDENT id), (bp, ep)
-  | [< ' ('0'..'9' as c); (b,len) = number_or_index bp [c] (store 0 c) >] ep ->
+      (try find_keyword loc id s with Not_found -> IDENT id), set_loc_pos loc bp ep
+  | [< ' ('0'..'9' as c); len = number (store 0 c) >] ep ->
       comment_stop bp;
-      (if b then INT (get_buff len) else INDEX (get_buff len)), (bp, ep)
-  | [< ''\"'; len = string None bp 0 >] ep ->
+      (INT (get_buff len), set_loc_pos loc bp ep)
+  | [< ''\"'; (loc,len) = string loc None bp 0 >] ep ->
       comment_stop bp;
-      (STRING (get_buff len), (bp, ep))
+      (STRING (get_buff len), set_loc_pos loc bp ep)
   | [< ' ('(' as c);
       t = parser
         | [< ''*'; s >] ->
             comm_loc bp;
             push_string "(*";
-            comment bp s;
-            next_token s
-        | [< t = process_chars bp c >] -> comment_stop bp; t >] ->
+            let loc = comment loc bp s in next_token loc s
+        | [< t = process_chars loc bp c >] -> comment_stop bp; t >] ->
       t
+  | [< ' ('{' | '}' as c); s >] ep ->
+      let t,new_between_commands =
+        if !between_commands then (KEYWORD (String.make 1 c), set_loc_pos loc bp ep), true
+        else process_chars loc bp c s, false
+      in
+      comment_stop bp; between_commands := new_between_commands; t
   | [< s >] ->
-      match lookup_utf8 s with
+      match lookup_utf8 loc s with
         | Utf8Token (Unicode.Letter, n) ->
-            let len = ident_tail (nstore n 0 s) s in
+            let len = ident_tail loc (nstore n 0 s) s in
             let id = get_buff len in
             let ep = Stream.count s in
             comment_stop bp;
-            (try find_keyword id s with Not_found -> IDENT id), (bp, ep)
-        | AsciiChar | Utf8Token ((Unicode.Symbol | Unicode.IdentPart), _) ->
-            let t = process_chars bp (Stream.next s) s in
-            let new_between_com = match t with
-              (KEYWORD ("{"|"}"),_) -> !between_com | _ -> false in
-            comment_stop bp; between_com := new_between_com; t
+            (try find_keyword loc id s with Not_found -> IDENT id), set_loc_pos loc bp ep
+        | AsciiChar | Utf8Token ((Unicode.Symbol | Unicode.IdentPart | Unicode.Unknown), _) ->
+            let t = process_chars loc bp (Stream.next s) s in
+            comment_stop bp; t
         | EmptyStream ->
-            comment_stop bp; (EOI, (bp, bp + 1))
+            comment_stop bp; (EOI, set_loc_pos loc bp (bp+1))
 
 (* (* Debug: uncomment this for tracing tokens seen by coq...*)
-let next_token s =
-  let (t,(bp,ep)) = next_token s in Printf.eprintf "[%s]\n%!" (Tok.to_string t);
-  (t,(bp,ep))
-*)
+let next_token loc s =
+  let (t,loc as r) = next_token loc s in
+  Printf.eprintf "(line %i, %i-%i)[%s]\n%!" (Ploc.line_nb loc) (Ploc.first_pos loc) (Ploc.last_pos loc) (Tok.to_string t);
+  r *)
 
 (* Location table system for creating tables associating a token count
    to its location in a char stream (the source) *)
@@ -605,12 +609,6 @@ let loct_func loct i =
 
 let loct_add loct i loc = Hashtbl.add loct i loc
 
-let current_location_table = ref (loct_create ())
-
-type location_table = (int, Compat.CompatLoc.t) Hashtbl.t
-let location_table () = !current_location_table
-let restore_location_table t = current_location_table := t
-
 (** {6 The lexer of Coq} *)
 
 (** Note: removing a token.
@@ -640,13 +638,14 @@ let token_text = function
 
 let func cs =
   let loct = loct_create () in
+  let cur_loc = ref (Compat.make_loc !current_file 1 0 0 0) in
   let ts =
     Stream.from
       (fun i ->
-         let (tok, loc) = next_token cs in
-         loct_add loct i (Compat.make_loc loc); Some tok)
+         let (tok, loc) = next_token !cur_loc cs in
+	 cur_loc := Compat.after loc;
+         loct_add loct i loc; Some tok)
   in
-  current_location_table := loct;
   (ts, loct_func loct)
 
 let lexer = {
@@ -680,16 +679,18 @@ module Token = struct
   end
 end
 
-let mk () _init_loc(*FIXME*) cs =
+let mk () =
   let loct = loct_create () in
-  let rec self =
+  let cur_loc = ref (Compat.make_loc !current_file 1 0 0 0) in
+  let rec self init_loc (* FIXME *) =
     parser i
-       [< (tok, loc) = next_token; s >] ->
-          let loc = Compat.make_loc loc in
-            loct_add loct i loc;
-            [< '(tok, loc); self s >]
+       [< (tok, loc) = next_token !cur_loc; s >] ->
+            cur_loc := Compat.set_loc_file loc !current_file;
+	    loct_add loct i loc;
+            [< '(tok, loc); self init_loc s >]
       | [< >] -> [< >]
-  in current_location_table := loct; self cs
+  in
+  self
 
 END
 
diff --git a/parsing/cLexer.mli b/parsing/cLexer.mli
index 24b0ec847..e0fdf8cb5 100644
--- a/parsing/cLexer.mli
+++ b/parsing/cLexer.mli
@@ -9,13 +9,7 @@
 val add_keyword : string -> unit
 val remove_keyword : string -> unit
 val is_keyword : string -> bool
-
-(* val location_function : int -> Loc.t *)
-
-(** for coqdoc *)
-type location_table
-val location_table : unit -> location_table
-val restore_location_table : location_table -> unit
+val keywords : unit -> CString.Set.t
 
 val check_ident : string -> unit
 val is_ident : string -> bool
@@ -25,12 +19,12 @@ type frozen_t
 val freeze : unit -> frozen_t
 val unfreeze : frozen_t -> unit
 
-type com_state
-val com_state: unit -> com_state
-val restore_com_state: com_state -> unit
-
 val xml_output_comment : (string -> unit) Hook.t
 
+(* Retrieve the comments lexed at a given location of the stream
+   currently being processeed *)
+val extract_comments : int -> string list
+
 val terminal : string -> Tok.t
 
 (** The lexer of Coq: *)
diff --git a/parsing/compat.ml4 b/parsing/compat.ml4
index 2b67693d2..4a36af2d8 100644
--- a/parsing/compat.ml4
+++ b/parsing/compat.ml4
@@ -10,6 +10,10 @@
 
 (** Locations *)
 
+let file_loc_of_file = function
+| None -> ""
+| Some f -> f
+
 IFDEF CAMLP5 THEN
 
 module CompatLoc = struct
@@ -20,17 +24,49 @@ end
 
 exception Exc_located = Ploc.Exc
 
-IFDEF CAMLP5_6_00 THEN
-let ploc_file_name = Ploc.file_name
-ELSE
-let ploc_file_name _ = ""
-END
-
 let to_coqloc loc =
-  Loc.create (ploc_file_name loc) (Ploc.line_nb loc)
-    (Ploc.bol_pos loc) (Ploc.first_pos loc, Ploc.last_pos loc)
+  { Loc.fname = Ploc.file_name loc;
+    Loc.line_nb = Ploc.line_nb loc;
+    Loc.bol_pos = Ploc.bol_pos loc;
+    Loc.bp = Ploc.first_pos loc;
+    Loc.ep = Ploc.last_pos loc;
+    Loc.line_nb_last = Ploc.line_nb_last loc;
+    Loc.bol_pos_last = Ploc.bol_pos_last loc; }
+
+let make_loc fname line_nb bol_pos bp ep = Ploc.make_loc (file_loc_of_file fname) line_nb bol_pos (bp, ep) ""
+
+(* Update a loc without allocating an intermediate pair *)
+let set_loc_pos loc bp ep =
+  Ploc.sub loc (bp - Ploc.first_pos loc) (ep - bp)
+
+(* Increase line number by 1 and update position of beginning of line *)
+let bump_loc_line loc bol_pos =
+  Ploc.make_loc (Ploc.file_name loc) (Ploc.line_nb loc + 1) bol_pos
+		(Ploc.first_pos loc, Ploc.last_pos loc) (Ploc.comment loc)
+
+(* Same as [bump_loc_line], but for the last line in location *)
+(* For an obscure reason, camlp5 does not give an easy way to set line_nb_stop,
+   so we have to resort to a hack merging two locations. *)
+(* Warning: [bump_loc_line_last] changes the end position. You may need to call
+   [set_loc_pos] to fix it. *)
+let bump_loc_line_last loc bol_pos =
+  let loc' =
+    Ploc.make_loc (Ploc.file_name loc) (Ploc.line_nb_last loc + 1) bol_pos
+		  (Ploc.first_pos loc + 1, Ploc.last_pos loc + 1) (Ploc.comment loc)
+  in
+  Ploc.encl loc loc'
+
+let set_loc_file loc fname =
+  Ploc.make_loc fname (Ploc.line_nb loc) (Ploc.bol_pos loc)
+		(Ploc.first_pos loc, Ploc.last_pos loc) (Ploc.comment loc)
 
-let make_loc = Ploc.make_unlined
+(* For some reason, the [Ploc.after] function of Camlp5 does not update line
+   numbers, so we define our own function that does it. *)
+let after loc =
+  let line_nb = Ploc.line_nb_last loc in
+  let bol_pos = Ploc.bol_pos_last loc in
+  Ploc.make_loc (Ploc.file_name loc) line_nb bol_pos
+		(Ploc.last_pos loc, Ploc.last_pos loc) (Ploc.comment loc)
 
 ELSE
 
@@ -39,11 +75,38 @@ module CompatLoc = Camlp4.PreCast.Loc
 exception Exc_located = CompatLoc.Exc_located
 
 let to_coqloc loc =
-  Loc.create (CompatLoc.file_name loc) (CompatLoc.start_line loc)
-    (CompatLoc.start_bol loc) (CompatLoc.start_off loc, CompatLoc.stop_off loc)
+  { Loc.fname = CompatLoc.file_name loc;
+    Loc.line_nb = CompatLoc.start_line loc;
+    Loc.bol_pos = CompatLoc.start_bol loc;
+    Loc.bp = CompatLoc.start_off loc;
+    Loc.ep = CompatLoc.stop_off loc;
+    Loc.line_nb_last = CompatLoc.stop_line loc;
+    Loc.bol_pos_last = CompatLoc.stop_bol loc; }
+
+let make_loc fname line_nb bol_pos start stop =
+  CompatLoc.of_tuple (file_loc_of_file fname, line_nb, bol_pos, start, line_nb, bol_pos, stop, false)
+
+open CompatLoc
+
+let set_loc_pos loc bp ep =
+  of_tuple (file_name loc, start_line loc, start_bol loc, bp,
+	    stop_line loc, stop_bol loc, ep, is_ghost loc)
+
+let bump_loc_line loc bol_pos =
+  of_tuple (file_name loc, start_line loc + 1, bol_pos, start_off loc,
+	    start_line loc + 1, bol_pos, stop_off loc, is_ghost loc)
+
+let bump_loc_line_last loc bol_pos =
+  of_tuple (file_name loc, start_line loc, start_bol loc, start_off loc,
+	    stop_line loc + 1, bol_pos, stop_off loc, is_ghost loc)
 
-let make_loc (start, stop) =
-  CompatLoc.of_tuple ("", 0, 0, start, 0, 0, stop, false)
+let set_loc_file loc fname =
+  of_tuple (file_loc_of_file fname, start_line loc, start_bol loc, start_off loc,
+	    stop_line loc, stop_bol loc, stop_off loc, is_ghost loc)
+
+let after loc =
+  of_tuple (file_name loc, stop_line loc, stop_bol loc, stop_off loc,
+	    stop_line loc, stop_bol loc, stop_off loc, is_ghost loc)
 
 END
 
@@ -79,12 +142,23 @@ module type LexerSig = sig
     exception E of t
     val to_string : t -> string
   end
+  type lexer_state
+  val init_lexer_state : string option -> lexer_state
+  val set_lexer_state : lexer_state -> unit
+  val release_lexer_state : unit -> lexer_state
+  val drop_lexer_state : unit -> unit
 end
 
 ELSE
 
-module type LexerSig =
-  Camlp4.Sig.Lexer with module Loc = CompatLoc and type Token.t = Tok.t
+module type LexerSig = sig
+  include Camlp4.Sig.Lexer with module Loc = CompatLoc and type Token.t = Tok.t
+  type lexer_state
+  val init_lexer_state : string option -> lexer_state
+  val set_lexer_state : lexer_state -> unit
+  val release_lexer_state : unit -> lexer_state
+  val drop_lexer_state : unit -> unit
+end
 
 END
 
@@ -103,10 +177,13 @@ module type GrammarSig = sig
       string option * Gramext.g_assoc option * production_rule list
   type extend_statment =
       Gramext.position option * single_extend_statment list
+  type coq_parsable
+  val parsable : ?file:string -> char Stream.t -> coq_parsable
   val action : 'a -> action
   val entry_create : string -> 'a entry
-  val entry_parse : 'a entry -> parsable -> 'a
+  val entry_parse : 'a entry -> coq_parsable -> 'a
   val entry_print : Format.formatter -> 'a entry -> unit
+  val with_parsable : coq_parsable -> ('a -> 'b) -> 'a -> 'b
   val srules' : production_rule list -> symbol
   val parse_tokens_after_filter : 'a entry -> Tok.t Stream.t -> 'a
 end
@@ -122,20 +199,37 @@ module GrammarMake (L:LexerSig) : GrammarSig = struct
       string option * Gramext.g_assoc option * production_rule list
   type extend_statment =
       Gramext.position option * single_extend_statment list
+  type coq_parsable = parsable * L.lexer_state ref
+  let parsable ?file c =
+    let state = ref (L.init_lexer_state file) in
+    L.set_lexer_state !state;
+    let a = parsable c in
+    state := L.release_lexer_state ();
+    (a,state)
   let action = Gramext.action
   let entry_create = Entry.create
-  let entry_parse e p =
-    try Entry.parse e p
+  let entry_parse e (p,state) =
+    L.set_lexer_state !state;
+    try
+      let c = Entry.parse e p in
+      state := L.release_lexer_state ();
+      c
     with Exc_located (loc,e) ->
+      L.drop_lexer_state ();
       let loc' = Loc.get_loc (Exninfo.info e) in
       let loc = match loc' with None -> to_coqloc loc | Some loc -> loc in
-      Loc.raise loc e
+      Loc.raise ~loc e
+  let with_parsable (p,state) f x =
+    L.set_lexer_state !state;
+    try
+      let a = f x in
+      state := L.release_lexer_state ();
+      a
+    with e ->
+      L.drop_lexer_state ();
+      raise e
 
-IFDEF CAMLP5_6_02_1 THEN
   let entry_print ft x = Entry.print ft x
-ELSE
-  let entry_print _ x = Entry.print x
-END
   let srules' = Gramext.srules
   let parse_tokens_after_filter = Entry.parse_token
 end
@@ -147,28 +241,44 @@ module type GrammarSig = sig
     with module Loc = CompatLoc and type Token.t = Tok.t
   type 'a entry = 'a Entry.t
   type action = Action.t
-  type parsable
-  val parsable : char Stream.t -> parsable
+  type coq_parsable
+  val parsable : ?file:string -> char Stream.t -> coq_parsable
   val action : 'a -> action
   val entry_create : string -> 'a entry
-  val entry_parse : 'a entry -> parsable -> 'a
+  val entry_parse : 'a entry -> coq_parsable -> 'a
   val entry_print : Format.formatter -> 'a entry -> unit
+  val with_parsable : coq_parsable -> ('a -> 'b) -> 'a -> 'b
   val srules' : production_rule list -> symbol
 end
 
 module GrammarMake (L:LexerSig) : GrammarSig = struct
   (* We need to refer to Coq's module Loc before it is hidden by include *)
-  let raise_coq_loc loc e = Loc.raise (to_coqloc loc) e
+  let raise_coq_loc loc e = Loc.raise ~loc:(to_coqloc loc) e
   include Camlp4.Struct.Grammar.Static.Make (L)
   type 'a entry = 'a Entry.t
   type action = Action.t
-  type parsable = char Stream.t
-  let parsable s = s
+  type coq_parsable = char Stream.t * L.lexer_state ref
+  let parsable ?file s = let state = ref (L.init_lexer_state file) in (s, state)
   let action = Action.mk
   let entry_create = Entry.mk
-  let entry_parse e s =
-    try parse e (*FIXME*)CompatLoc.ghost s
-    with Exc_located (loc,e) -> raise_coq_loc loc e
+  let entry_parse e (s,state) =
+    L.set_lexer_state !state;
+    try
+      let c = parse e (*FIXME*)CompatLoc.ghost s in
+      state := L.release_lexer_state ();
+      c
+    with Exc_located (loc,e) ->
+      L.drop_lexer_state ();
+      raise_coq_loc loc e;;
+  let with_parsable (p,state) f x =
+    L.set_lexer_state !state;
+    try
+      let a = f x in
+      state := L.release_lexer_state ();
+      a
+    with e ->
+      L.drop_lexer_state ();
+      Pervasives.raise e;;
   let entry_print ft x = Entry.print ft x
   let srules' = srules (entry_create "dummy")
 end
@@ -202,7 +312,6 @@ IFDEF CAMLP5 THEN
     | Tok.PATTERNIDENT s -> "PATTERNIDENT", s
     | Tok.FIELD s -> "FIELD", s
     | Tok.INT s -> "INT", s
-    | Tok.INDEX s -> "INDEX", s
     | Tok.STRING s -> "STRING", s
     | Tok.LEFTQMARK -> "LEFTQMARK", ""
     | Tok.BULLET s -> "BULLET", s
@@ -216,13 +325,13 @@ ELSE
   | tok -> Gramext.Stoken (Tok.equal tok, G.Token.to_string tok)
 END
 
-IFDEF CAMLP5_6_00 THEN
-  let slist0sep (x, y) = Gramext.Slist0sep (x, y, false)
-  let slist1sep (x, y) = Gramext.Slist1sep (x, y, false)
-ELSE
-  let slist0sep (x, y) = Gramext.Slist0sep (x, y)
-  let slist1sep (x, y) = Gramext.Slist1sep (x, y)
-END
+  IFDEF CAMLP5 THEN
+     let slist0sep (x, y) = Gramext.Slist0sep (x, y, false)
+     let slist1sep (x, y) = Gramext.Slist1sep (x, y, false)
+  ELSE
+    let slist0sep (x, y) = Gramext.Slist0sep (x, y)
+    let slist1sep (x, y) = Gramext.Slist1sep (x, y)
+  END
 
   let snterml (x, y) = Gramext.Snterml (x, y)
   let snterm x = Gramext.Snterm x
diff --git a/parsing/egramcoq.ml b/parsing/egramcoq.ml
index 21a9afa29..07e4ddf84 100644
--- a/parsing/egramcoq.ml
+++ b/parsing/egramcoq.ml
@@ -6,12 +6,13 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-open Errors
+open CErrors
 open Util
 open Pcoq
-open Extend
 open Constrexpr
+open Notation
 open Notation_term
+open Extend
 open Libnames
 open Names
 
@@ -70,7 +71,7 @@ let error_level_assoc p current expected =
     | Extend.LeftA -> str "left"
     | Extend.RightA -> str "right"
     | Extend.NonA -> str "non" in
-  errorlabstrm ""
+  user_err 
     (str "Level " ++ int p ++ str " is already declared " ++
      pr_assoc current ++ str " associative while it is now expected to be " ++
      pr_assoc expected ++ str " associative.")
@@ -320,13 +321,6 @@ let cases_pattern_expr_of_name (loc,na) = match na with
   | Anonymous -> CPatAtom (loc,None)
   | Name id -> CPatAtom (loc,Some (Ident (loc,id)))
 
-type grammar_constr_prod_item =
-  | GramConstrTerminal of Tok.t
-  | GramConstrNonTerminal of constr_prod_entry_key * Id.t option
-  | GramConstrListMark of int * bool
-    (* tells action rule to make a list of the n previous parsed items;
-       concat with last parsed list if true *)
-
 type 'r env = {
   constrs : 'r list;
   constrlists : 'r list list;
@@ -440,18 +434,10 @@ let make_act : type r. r target -> _ -> r gen_eval = function
   CNotation (loc, notation , env)
 | ForPattern -> fun notation loc env ->
   let invalid = List.exists (fun (_, b) -> not b) env.binders in
-  let () = if invalid then Topconstr.error_invalid_pattern_notation loc in
+  let () = if invalid then Topconstr.error_invalid_pattern_notation ~loc () in
   let env = (env.constrs, env.constrlists) in
   CPatNotation (loc, notation, env, [])
 
-type notation_grammar = {
-  notgram_level : int;
-  notgram_assoc : gram_assoc option;
-  notgram_notation : notation;
-  notgram_prods : grammar_constr_prod_item list list;
-  notgram_typs : notation_var_internalization_type list;
-}
-
 let extend_constr state forpat ng =
   let n = ng.notgram_level in
   let assoc = ng.notgram_assoc in
@@ -463,7 +449,6 @@ let extend_constr state forpat ng =
     let isforpat = target_to_bool forpat in
     let needed_levels, state = register_empty_levels state isforpat pure_sublevels in
     let (pos,p4assoc,name,reinit), state = find_position state isforpat assoc level in
-    let nb_decls = List.length needed_levels + 1 in
     let empty_rules = List.map (prepare_empty_levels isforpat) needed_levels in
     let empty = { constrs = []; constrlists = []; binders = [] } in
     let act = ty_eval r (make_act forpat ng.notgram_notation) empty in
@@ -491,12 +476,3 @@ let constr_grammar : (Notation.level * notation_grammar) grammar_command =
   create_grammar_command "Notation" extend_constr_notation
 
 let extend_constr_grammar pr ntn = extend_grammar_command constr_grammar (pr, ntn)
-
-let recover_constr_grammar ntn prec =
-  let filter (prec', ng) =
-    if Notation.level_eq prec prec' && String.equal ntn ng.notgram_notation then Some ng
-    else None
-  in
-  match List.map_filter filter (recover_grammar_command constr_grammar) with
-  | [x] -> x
-  | _ -> assert false
diff --git a/parsing/egramcoq.mli b/parsing/egramcoq.mli
index 1fe06a29d..6dda3817a 100644
--- a/parsing/egramcoq.mli
+++ b/parsing/egramcoq.mli
@@ -19,28 +19,7 @@ open Egramml
 (** This is the part specific to Coq-level Notation and Tactic Notation.
     For the ML-level tactic and vernac extensions, see Egramml. *)
 
-(** For constr notations *)
-
-type grammar_constr_prod_item =
-  | GramConstrTerminal of Tok.t
-  | GramConstrNonTerminal of constr_prod_entry_key * Id.t option
-  | GramConstrListMark of int * bool
-    (* tells action rule to make a list of the n previous parsed items;
-       concat with last parsed list if true *)
-
-type notation_grammar = {
-  notgram_level : int;
-  notgram_assoc : gram_assoc option;
-  notgram_notation : notation;
-  notgram_prods : grammar_constr_prod_item list list;
-  notgram_typs : notation_var_internalization_type list;
-}
-
 (** {5 Adding notations} *)
 
-val extend_constr_grammar : Notation.level -> notation_grammar -> unit
+val extend_constr_grammar : Notation.level -> Notation_term.notation_grammar -> unit
 (** Add a term notation rule to the parsing system. *)
-
-val recover_constr_grammar : notation -> Notation.level -> notation_grammar
-(** For a declared grammar, returns the rule + the ordered entry types
-    of variables in the rule (for use in the interpretation) *)
diff --git a/parsing/g_constr.ml4 b/parsing/g_constr.ml4
index 243f71416..47455f984 100644
--- a/parsing/g_constr.ml4
+++ b/parsing/g_constr.ml4
@@ -55,9 +55,9 @@ let mk_fixb (id,bl,ann,body,(loc,tyc)) =
 
 let mk_cofixb (id,bl,ann,body,(loc,tyc)) =
   let _ = Option.map (fun (aloc,_) ->
-    Errors.user_err_loc
-      (aloc,"Constr:mk_cofixb",
-       Pp.str"Annotation forbidden in cofix expression.")) (fst ann) in
+    CErrors.user_err ~loc:aloc
+      ~hdr:"Constr:mk_cofixb"
+      (Pp.str"Annotation forbidden in cofix expression.")) (fst ann) in
   let ty = match tyc with
       Some ty -> ty
     | None -> CHole (loc, None, IntroAnonymous, None) in
@@ -127,7 +127,7 @@ let name_colon =
 let aliasvar = function CPatAlias (loc, _, id) -> Some (loc,Name id) | _ -> None
 
 GEXTEND Gram
-  GLOBAL: binder_constr lconstr constr operconstr sort global
+  GLOBAL: binder_constr lconstr constr operconstr universe_level sort global
   constr_pattern lconstr_pattern Constr.ident
   closed_binder open_binders binder binders binders_fixannot
   record_declaration typeclass_constraint pattern appl_arg;
@@ -215,9 +215,6 @@ GEXTEND Gram
 	  CGeneralization (!@loc, Implicit, None, c)
       | "`("; c = operconstr LEVEL "200"; ")" ->
 	  CGeneralization (!@loc, Explicit, None, c)
-      | IDENT "ltac"; ":"; "("; tac = Tactic.tactic_expr; ")" ->
-          let arg = Genarg.in_gen (Genarg.rawwit Constrarg.wit_tactic) tac in
-          CHole (!@loc, None, IntroAnonymous, Some arg)
       ] ]
   ;
   record_declaration:
@@ -298,10 +295,10 @@ GEXTEND Gram
       | -> [] ] ]
   ;
   instance:
-    [ [ "@{"; l = LIST1 level; "}" -> Some l
+    [ [ "@{"; l = LIST1 universe_level; "}" -> Some l
       | -> None ] ]
   ;
-  level:
+  universe_level:
     [ [ "Set" -> GSet
       | "Prop" -> GProp
       | "Type" -> GType None
@@ -380,14 +377,14 @@ GEXTEND Gram
       [ p = pattern; lp = LIST1 NEXT ->
         (match p with
 	  | CPatAtom (_, Some r) -> CPatCstr (!@loc, r, None, lp)
-	  | CPatCstr (_, r, None, l2) -> Errors.user_err_loc
-              (cases_pattern_expr_loc p, "compound_pattern",
-               Pp.str "Nested applications not supported.")
+	  | CPatCstr (_, r, None, l2) -> CErrors.user_err
+              ~loc:(cases_pattern_expr_loc p) ~hdr:"compound_pattern"
+              (Pp.str "Nested applications not supported.")
 	  | CPatCstr (_, r, l1, l2) -> CPatCstr (!@loc, r, l1 , l2@lp)
 	  | CPatNotation (_, n, s, l) -> CPatNotation (!@loc, n , s, l@lp)
-          | _ -> Errors.user_err_loc
-              (cases_pattern_expr_loc p, "compound_pattern",
-               Pp.str "Such pattern cannot have arguments."))
+          | _ -> CErrors.user_err
+              ~loc:(cases_pattern_expr_loc p) ~hdr:"compound_pattern"
+              (Pp.str "Such pattern cannot have arguments."))
       |"@"; r = Prim.reference; lp = LIST0 NEXT ->
         CPatCstr (!@loc, r, Some lp, []) ]
     | "1" LEFTA
@@ -401,6 +398,14 @@ GEXTEND Gram
               CPatPrim (_,Numeral z) when Bigint.is_pos_or_zero z ->
                 CPatNotation(!@loc,"( _ )",([p],[]),[])
             | _ -> p)
+      | "("; p = pattern LEVEL "200"; ":"; ty = lconstr; ")" ->
+          let p =
+            match p with
+              CPatPrim (_,Numeral z) when Bigint.is_pos_or_zero z ->
+                CPatNotation(!@loc,"( _ )",([p],[]),[])
+            | _ -> p
+          in
+	  CPatCast (!@loc, p, ty)
       | n = INT -> CPatPrim (!@loc, Numeral (Bigint.of_string n))
       | s = string -> CPatPrim (!@loc, String s) ] ]
   ;
@@ -476,6 +481,13 @@ GEXTEND Gram
 	  List.map (fun (n, b, t) -> LocalRawAssum ([n], Generalized (Implicit, Explicit, b), t)) tc
       | "`{"; tc = LIST1 typeclass_constraint SEP "," ; "}" ->
 	  List.map (fun (n, b, t) -> LocalRawAssum ([n], Generalized (Implicit, Implicit, b), t)) tc
+      | "'"; p = pattern LEVEL "0" ->
+          let (p, ty) =
+            match p with
+            | CPatCast (_, p, ty) -> (p, Some ty)
+            | _ -> (p, None)
+          in
+          [LocalPattern (!@loc, p, ty)]
     ] ]
   ;
   typeclass_constraint:
diff --git a/parsing/g_prim.ml4 b/parsing/g_prim.ml4
index 0d72f7b93..820514b08 100644
--- a/parsing/g_prim.ml4
+++ b/parsing/g_prim.ml4
@@ -28,11 +28,11 @@ let my_int_of_string loc s =
     if n > 1024 * 2048 then raise Exit;
     n
   with Failure _ | Exit ->
-    Errors.user_err_loc (loc,"",Pp.str "Cannot support a so large number.")
+    CErrors.user_err ~loc  (Pp.str "Cannot support a so large number.")
 
 GEXTEND Gram
   GLOBAL:
-    bigint natural index integer identref name ident var preident
+    bigint natural integer identref name ident var preident
     fullyqualid qualid reference dirpath ne_lstring
     ne_string string pattern_ident pattern_identref by_notation smart_global;
   preident:
@@ -93,7 +93,7 @@ GEXTEND Gram
   ;
   ne_string:
     [ [ s = STRING ->
-        if s="" then Errors.user_err_loc(!@loc, "", Pp.str"Empty string."); s
+        if s="" then CErrors.user_err ~loc:(!@loc) (Pp.str"Empty string."); s
     ] ]
   ;
   ne_lstring:
@@ -113,9 +113,6 @@ GEXTEND Gram
   natural:
     [ [ i = INT -> my_int_of_string (!@loc) i ] ]
   ;
-  index:
-    [ [ i = INDEX -> my_int_of_string (!@loc) i ] ]
-  ;
   bigint: (* Negative numbers are dealt with specially *)
     [ [ i = INT -> (Bigint.of_string i) ] ]
   ;
diff --git a/parsing/g_proofs.ml4 b/parsing/g_proofs.ml4
index 422384f3d..4c5280538 100644
--- a/parsing/g_proofs.ml4
+++ b/parsing/g_proofs.ml4
@@ -13,7 +13,6 @@ open Misctypes
 open Tok
 
 open Pcoq
-open Pcoq.Tactic
 open Pcoq.Prim
 open Pcoq.Constr
 open Pcoq.Vernac_
@@ -26,9 +25,11 @@ let hint_proof_using e = function
      | None -> None
      | Some s -> Some (Gram.entry_parse e (Gram.parsable (Stream.of_string s)))
 
+let hint = Gram.entry_create "hint"
+
 (* Proof commands *)
 GEXTEND Gram
-  GLOBAL: command;
+  GLOBAL: hint command;
 
   opt_hintbases:
   [ [ -> []
@@ -39,12 +40,6 @@ GEXTEND Gram
       | IDENT "Proof" ->
           VernacProof (None,hint_proof_using G_vernac.section_subset_expr None)
       | IDENT "Proof" ; IDENT "Mode" ; mn = string -> VernacProofMode mn
-      | IDENT "Proof"; "with"; ta = tactic; 
-        l = OPT [ "using"; l = G_vernac.section_subset_expr -> l ] ->
-          VernacProof (Some ta,hint_proof_using G_vernac.section_subset_expr l)
-      | IDENT "Proof"; "using"; l = G_vernac.section_subset_expr;
-        ta = OPT [ "with"; ta = tactic -> ta ] ->
-          VernacProof (ta,Some l)
       | IDENT "Proof"; c = lconstr -> VernacExactProof c
       | IDENT "Abort" -> VernacAbort None
       | IDENT "Abort"; IDENT "All" -> VernacAbortAll
@@ -88,7 +83,7 @@ GEXTEND Gram
       | IDENT "Show"; IDENT "Proof" -> VernacShow ShowProof
       | IDENT "Show"; IDENT "Intro" -> VernacShow (ShowIntros false)
       | IDENT "Show"; IDENT "Intros" -> VernacShow (ShowIntros true)
-      | IDENT "Show"; IDENT "Match"; id = identref -> VernacShow (ShowMatch id)
+      | IDENT "Show"; IDENT "Match"; id = reference -> VernacShow (ShowMatch id)
       | IDENT "Show"; IDENT "Thesis" -> VernacShow ShowThesis
       | IDENT "Guarded" -> VernacCheckGuard
       (* Hints for Auto and EAuto *)
@@ -103,10 +98,9 @@ GEXTEND Gram
       (* Declare "Resolve" explicitly so as to be able to later extend with
          "Resolve ->" and "Resolve <-" *)
       | IDENT "Hint"; IDENT "Resolve"; lc = LIST1 reference_or_constr; 
-	  pri = OPT [ "|"; i = natural -> i ];
-	  dbnames = opt_hintbases ->
+	info = hint_info; dbnames = opt_hintbases ->
 	  VernacHints (false,dbnames,
-	    HintsResolve (List.map (fun x -> (pri, true, x)) lc))
+	    HintsResolve (List.map (fun x -> (info, true, x)) lc))
       ] ];
   obsolete_locality:
     [ [ IDENT "Local" -> true | -> false ] ]
@@ -116,24 +110,22 @@ GEXTEND Gram
      | c = constr -> HintsConstr c ] ]
   ;
   hint:
-    [ [ IDENT "Resolve"; lc = LIST1 reference_or_constr; 
-	pri = OPT [ "|"; i = natural -> i ] ->
-          HintsResolve (List.map (fun x -> (pri, true, x)) lc)
+    [ [ IDENT "Resolve"; lc = LIST1 reference_or_constr; info = hint_info ->
+          HintsResolve (List.map (fun x -> (info, true, x)) lc)
       | IDENT "Immediate"; lc = LIST1 reference_or_constr -> HintsImmediate lc
       | IDENT "Transparent"; lc = LIST1 global -> HintsTransparency (lc, true)
       | IDENT "Opaque"; lc = LIST1 global -> HintsTransparency (lc, false)
       | IDENT "Mode"; l = global; m = mode -> HintsMode (l, m)
       | IDENT "Unfold"; lqid = LIST1 global -> HintsUnfold lqid
-      | IDENT "Constructors"; lc = LIST1 global -> HintsConstructors lc
-      | IDENT "Extern"; n = natural; c = OPT constr_pattern ; "=>";
-          tac = tactic ->
-	  HintsExtern (n,c,tac) ] ]
+      | IDENT "Constructors"; lc = LIST1 global -> HintsConstructors lc ] ]
     ;
   constr_body:
     [ [ ":="; c = lconstr -> c
       | ":"; t = lconstr; ":="; c = lconstr -> CCast(!@loc,c,CastConv t) ] ]
   ;
   mode:
-    [ [ l = LIST1 ["+" -> true | "-" -> false] -> l ] ]
+    [ [ l = LIST1 [ "+" -> ModeInput
+                  | "!" -> ModeNoHeadEvar
+                  | "-" -> ModeOutput ] -> l ] ]
   ;
 END
diff --git a/parsing/g_vernac.ml4 b/parsing/g_vernac.ml4
index 0df15babd..d46880831 100644
--- a/parsing/g_vernac.ml4
+++ b/parsing/g_vernac.ml4
@@ -8,7 +8,7 @@
 
 open Pp
 open Compat
-open Errors
+open CErrors
 open Util
 open Names
 open Constrexpr
@@ -115,7 +115,7 @@ GEXTEND Gram
                     | Some (SelectNth g) -> c (Some g)
                     | None -> c None
                     | _ ->
-                        VernacError (UserError ("",str"Typing and evaluation commands, cannot be used with the \"all:\" selector."))
+                        VernacError (UserError (None,str"Typing and evaluation commands, cannot be used with the \"all:\" selector."))
                   end ] ]
   ;
   located_vernac:
@@ -123,18 +123,26 @@ GEXTEND Gram
   ;
 END
 
-let test_plural_form = function
+let warn_plural_command =
+  CWarnings.create ~name:"plural-command" ~category:"pedantic" ~default:CWarnings.Disabled
+         (fun kwd -> strbrk (Printf.sprintf "Command \"%s\" expects more than one assumption." kwd))
+
+let test_plural_form loc kwd = function
   | [(_,([_],_))] ->
-      Flags.if_verbose Feedback.msg_warning
-   (strbrk "Keywords Variables/Hypotheses/Parameters expect more than one assumption")
+     warn_plural_command ~loc:!@loc kwd
   | _ -> ()
 
-let test_plural_form_types = function
+let test_plural_form_types loc kwd = function
   | [([_],_)] ->
-      Flags.if_verbose Feedback.msg_warning
-   (strbrk "Keywords Implicit Types expect more than one type")
+     warn_plural_command ~loc:!@loc kwd
   | _ -> ()
 
+let fresh_var env c =
+  Namegen.next_ident_away (Id.of_string "pat")
+    (env @ Id.Set.elements (Topconstr.free_vars_of_constr_expr c))
+
+let _ = Hook.set Constrexpr_ops.fresh_var_hook fresh_var
+
 (* Gallina declarations *)
 GEXTEND Gram
   GLOBAL: gallina gallina_ext thm_token def_body of_type_with_opt_coercion
@@ -149,8 +157,8 @@ GEXTEND Gram
           VernacStartTheoremProof (thm, (Some id,(bl,c,None))::l, false)
       | stre = assumption_token; nl = inline; bl = assum_list ->
 	  VernacAssumption (stre, nl, bl)
-      | stre = assumptions_token; nl = inline; bl = assum_list ->
-	  test_plural_form bl;
+      | (kwd,stre) = assumptions_token; nl = inline; bl = assum_list ->
+	  test_plural_form loc kwd bl;
 	  VernacAssumption (stre, nl, bl)
       | d = def_token; id = pidentref; b = def_body ->
           VernacDefinition (d, id, b)
@@ -203,11 +211,11 @@ GEXTEND Gram
       | IDENT "Conjecture" -> (None, Conjectural) ] ]
   ;
   assumptions_token:
-    [ [ IDENT "Hypotheses" -> (Some Discharge, Logical)
-      | IDENT "Variables" -> (Some Discharge, Definitional)
-      | IDENT "Axioms" -> (None, Logical)
-      | IDENT "Parameters" -> (None, Definitional)
-      | IDENT "Conjectures" -> (None, Conjectural) ] ]
+    [ [ IDENT "Hypotheses" -> ("Hypotheses", (Some Discharge, Logical))
+      | IDENT "Variables" -> ("Variables", (Some Discharge, Definitional))
+      | IDENT "Axioms" -> ("Axioms", (None, Logical))
+      | IDENT "Parameters" -> ("Parameters", (None, Definitional))
+      | IDENT "Conjectures" -> ("Conjectures", (None, Conjectural)) ] ]
   ;
   inline:
     [ [ IDENT "Inline"; "("; i = INT; ")" -> InlineAt (int_of_string i)
@@ -218,8 +226,8 @@ GEXTEND Gram
     [ [ i = identref; l = OPT [ "@{" ; l = LIST0 identref; "}" -> l ] -> (i,l) ] ]
   ;
   univ_constraint:
-    [ [ l = identref; ord = [ "<" -> Univ.Lt | "=" -> Univ.Eq | "<=" -> Univ.Le ];
-	r = identref -> (l, ord, r) ] ]
+    [ [ l = universe_level; ord = [ "<" -> Univ.Lt | "=" -> Univ.Eq | "<=" -> Univ.Le ];
+	r = universe_level -> (l, ord, r) ] ]
   ;
   finite_token:
     [ [ "Inductive" -> (Inductive_kw,Finite)
@@ -235,16 +243,24 @@ GEXTEND Gram
   (* Simple definitions *)
   def_body:
     [ [ bl = binders; ":="; red = reduce; c = lconstr ->
+      let (bl, c) = expand_pattern_binders mkCLambdaN bl c in
       (match c with
           CCast(_,c, CastConv t) -> DefineBody (bl, red, c, Some t)
         | _ -> DefineBody (bl, red, c, None))
     | bl = binders; ":"; t = lconstr; ":="; red = reduce; c = lconstr ->
-	DefineBody (bl, red, c, Some t)
+        let ((bl, c), tyo) =
+          if List.exists (function LocalPattern _ -> true | _ -> false) bl
+          then
+            let c = CCast (!@loc, c, CastConv t) in
+            (expand_pattern_binders mkCLambdaN bl c, None)
+          else ((bl, c), Some t)
+        in
+	DefineBody (bl, red, c, tyo)
     | bl = binders; ":"; t = lconstr ->
         ProveBody (bl, t) ] ]
   ;
   reduce:
-    [ [ IDENT "Eval"; r = Tactic.red_expr; "in" -> Some r
+    [ [ IDENT "Eval"; r = red_expr; "in" -> Some r
       | -> None ] ]
   ;
   one_decl_notation:
@@ -408,6 +424,10 @@ let starredidentreflist_to_expr l =
   | [] -> SsEmpty
   | x :: xs -> List.fold_right (fun i acc -> SsUnion(i,acc)) xs x
 
+let warn_deprecated_include_type =
+  CWarnings.create ~name:"deprecated-include-type" ~category:"deprecated"
+         (fun () -> strbrk "Include Type is deprecated; use Include instead")
+
 (* Modules and Sections *)
 GEXTEND Gram
   GLOBAL: gallina_ext module_expr module_type section_subset_expr;
@@ -447,9 +467,8 @@ GEXTEND Gram
       | IDENT "Include"; e = module_type_inl; l = LIST0 ext_module_expr ->
 	  VernacInclude(e::l)
       | IDENT "Include"; "Type"; e = module_type_inl; l = LIST0 ext_module_type ->
-	  Flags.if_verbose
-            Feedback.msg_warning (strbrk "Include Type is deprecated; use Include instead");
-          VernacInclude(e::l) ] ]
+	 warn_deprecated_include_type ~loc:!@loc ();
+	 VernacInclude(e::l) ] ]
   ;
   export_token:
     [ [ IDENT "Import" -> Some false
@@ -553,9 +572,17 @@ GEXTEND Gram
   ;
 END
 
+let warn_deprecated_arguments_scope =
+  CWarnings.create ~name:"deprecated-arguments-scope" ~category:"deprecated"
+         (fun () -> strbrk "Arguments Scope is deprecated; use Arguments instead")
+
+let warn_deprecated_implicit_arguments =
+  CWarnings.create ~name:"deprecated-implicit-arguments" ~category:"deprecated"
+         (fun () -> strbrk "Implicit Arguments is deprecated; use Arguments instead")
+
 (* Extensions: implicits, coercions, etc. *)
 GEXTEND Gram
-  GLOBAL: gallina_ext instance_name;
+  GLOBAL: gallina_ext instance_name hint_info;
 
   gallina_ext:
     [ [ (* Transparent and Opaque *)
@@ -608,81 +635,66 @@ GEXTEND Gram
 
       | IDENT "Instance"; namesup = instance_name; ":";
 	 expl = [ "!" -> Decl_kinds.Implicit | -> Decl_kinds.Explicit ] ; t = operconstr LEVEL "200";
-	 pri = OPT [ "|"; i = natural -> i ] ;
+	 info = hint_info ;
 	 props = [ ":="; "{"; r = record_declaration; "}" -> Some (true,r) |
 	     ":="; c = lconstr -> Some (false,c) | -> None ] ->
-	   VernacInstance (false,snd namesup,(fst namesup,expl,t),props,pri)
+	   VernacInstance (false,snd namesup,(fst namesup,expl,t),props,info)
 
       | IDENT "Existing"; IDENT "Instance"; id = global;
-          pri = OPT [ "|"; i = natural -> i ] ->
-	  VernacDeclareInstances ([id], pri)
+          info = hint_info ->
+	  VernacDeclareInstances [id, info]
+
       | IDENT "Existing"; IDENT "Instances"; ids = LIST1 global;
-          pri = OPT [ "|"; i = natural -> i ] ->
-	  VernacDeclareInstances (ids, pri)
+        pri = OPT [ "|"; i = natural -> i ] ->
+         let info = { hint_priority = pri; hint_pattern = None } in
+         let insts = List.map (fun i -> (i, info)) ids in
+	  VernacDeclareInstances insts
 
       | IDENT "Existing"; IDENT "Class"; is = global -> VernacDeclareClass is
 
       (* Arguments *)
       | IDENT "Arguments"; qid = smart_global; 
-        impl = LIST1 [ l = LIST0
-        [ item = argument_spec ->
-            let id, r, s = item in [`Id (id,r,s,false,false)]
-        | "/" -> [`Slash]
-        | "("; items = LIST1 argument_spec; ")"; sc = OPT scope ->
-            let f x = match sc, x with
-            | None, x -> x | x, None -> Option.map (fun y -> !@loc, y) x
-            | Some _, Some _ -> error "scope declared twice" in
-            List.map (fun (id,r,s) -> `Id(id,r,f s,false,false)) items
-        | "["; items = LIST1 argument_spec; "]"; sc = OPT scope ->
-            let f x = match sc, x with
-            | None, x -> x | x, None -> Option.map (fun y -> !@loc, y) x
-            | Some _, Some _ -> error "scope declared twice" in
-            List.map (fun (id,r,s) -> `Id(id,r,f s,true,false)) items
-        | "{"; items = LIST1 argument_spec; "}"; sc = OPT scope ->
-            let f x = match sc, x with
-            | None, x -> x | x, None -> Option.map (fun y -> !@loc, y) x
-            | Some _, Some _ -> error "scope declared twice" in
-            List.map (fun (id,r,s) -> `Id(id,r,f s,true,true)) items
-        ] -> l ] SEP ",";
+        args = LIST0 argument_spec_block;
+        more_implicits = OPT
+          [ ","; impl = LIST1
+            [ impl = LIST0 more_implicits_block -> List.flatten impl]
+            SEP "," -> impl
+          ];
         mods = OPT [ ":"; l = LIST1 arguments_modifier SEP "," -> l ] ->
          let mods = match mods with None -> [] | Some l -> List.flatten l in
-         let impl = List.map List.flatten impl in
-         let rec aux n (narg, impl) = function
-           | `Id x :: tl -> aux (n+1) (narg, impl@[x]) tl
-           | `Slash :: tl -> aux (n+1) (n, impl) tl
-           | [] -> narg, impl in
-         let nargs, impl = List.split (List.map (aux 0 (-1, [])) impl) in
-         let nargs, rest = List.hd nargs, List.tl nargs in
-         if List.exists (fun arg -> not (Int.equal arg nargs)) rest then
-           error "All arguments lists must have the same length";
-         let err_incompat x y =
-           error ("Options \""^x^"\" and \""^y^"\" are incompatible") in
-         if nargs > 0 && List.mem `ReductionNeverUnfold mods then
-           err_incompat "simpl never" "/";
-         if List.mem `ReductionNeverUnfold mods &&
-            List.mem `ReductionDontExposeCase mods then
-           err_incompat "simpl never" "simpl nomatch";
-         VernacArguments (qid, impl, nargs, mods)
-
+         let slash_position = ref None in
+         let rec parse_args i = function
+           | [] -> []
+           | `Id x :: args -> x :: parse_args (i+1) args
+           | `Slash :: args ->
+              if Option.is_empty !slash_position then
+                (slash_position := Some i; parse_args i args)
+              else
+                error "The \"/\" modifier can occur only once"
+         in
+         let args = parse_args 0 (List.flatten args) in
+         let more_implicits = Option.default [] more_implicits in
+         VernacArguments (qid, args, more_implicits, !slash_position, mods)
+
+ 
      (* moved there so that camlp5 factors it with the previous rule *)
      | IDENT "Arguments"; IDENT "Scope"; qid = smart_global;
        "["; scl = LIST0 [ "_" -> None | sc = IDENT -> Some sc ]; "]" ->
-       Feedback. msg_warning (strbrk "Arguments Scope is deprecated; use Arguments instead");
+	warn_deprecated_arguments_scope ~loc:!@loc ();
         VernacArgumentsScope (qid,scl)
 
       (* Implicit *)
       | IDENT "Implicit"; IDENT "Arguments"; qid = smart_global;
 	   pos = LIST0 [ "["; l = LIST0 implicit_name; "]" ->
 	     List.map (fun (id,b,f) -> (ExplByName id,b,f)) l ] ->
-	   Flags.if_verbose
-            Feedback.msg_warning (strbrk "Implicit Arguments is deprecated; use Arguments instead");
-	   VernacDeclareImplicits (qid,pos)
+	 warn_deprecated_implicit_arguments ~loc:!@loc ();
+	 VernacDeclareImplicits (qid,pos)
 
       | IDENT "Implicit"; "Type"; bl = reserv_list ->
 	   VernacReserve bl
 
       | IDENT "Implicit"; IDENT "Types"; bl = reserv_list ->
-          test_plural_form_types bl;
+          test_plural_form_types loc "Implicit Types" bl;
            VernacReserve bl
 
       | IDENT "Generalizable"; 
@@ -721,6 +733,54 @@ GEXTEND Gram
        snd id, not (Option.is_empty b), Option.map (fun x -> !@loc, x) s
     ]
   ];
+  (* List of arguments implicit status, scope, modifiers *)
+  argument_spec_block: [
+    [ item = argument_spec ->
+      let name, recarg_like, notation_scope = item in
+      [`Id { name=name; recarg_like=recarg_like;
+             notation_scope=notation_scope;
+             implicit_status = NotImplicit}]
+    | "/" -> [`Slash]
+    | "("; items = LIST1 argument_spec; ")"; sc = OPT scope ->
+       let f x = match sc, x with
+         | None, x -> x | x, None -> Option.map (fun y -> !@loc, y) x
+         | Some _, Some _ -> error "scope declared twice" in
+       List.map (fun (name,recarg_like,notation_scope) ->
+           `Id { name=name; recarg_like=recarg_like;
+                 notation_scope=f notation_scope;
+                 implicit_status = NotImplicit}) items
+    | "["; items = LIST1 argument_spec; "]"; sc = OPT scope ->
+       let f x = match sc, x with
+         | None, x -> x | x, None -> Option.map (fun y -> !@loc, y) x
+         | Some _, Some _ -> error "scope declared twice" in
+       List.map (fun (name,recarg_like,notation_scope) ->
+           `Id { name=name; recarg_like=recarg_like;
+                 notation_scope=f notation_scope;
+                 implicit_status = Implicit}) items
+    | "{"; items = LIST1 argument_spec; "}"; sc = OPT scope ->
+       let f x = match sc, x with
+         | None, x -> x | x, None -> Option.map (fun y -> !@loc, y) x
+         | Some _, Some _ -> error "scope declared twice" in
+       List.map (fun (name,recarg_like,notation_scope) ->
+           `Id { name=name; recarg_like=recarg_like;
+                 notation_scope=f notation_scope;
+                 implicit_status = MaximallyImplicit}) items
+    ]
+  ];
+  name_or_bang: [
+       [ b = OPT "!"; id = name ->
+       not (Option.is_empty b), id
+    ]
+  ];
+  (* Same as [argument_spec_block], but with only implicit status and names *)
+  more_implicits_block: [
+    [ name = name -> [(snd name, Vernacexpr.NotImplicit)]
+    | "["; items = LIST1 name; "]" ->
+       List.map (fun name -> (snd name, Vernacexpr.Implicit)) items
+    | "{"; items = LIST1 name; "}" ->
+       List.map (fun name -> (snd name, Vernacexpr.MaximallyImplicit)) items
+    ]
+  ];
   strategy_level:
     [ [ IDENT "expand" -> Conv_oracle.Expand
       | IDENT "opaque" -> Conv_oracle.Opaque
@@ -734,6 +794,11 @@ GEXTEND Gram
           (Option.default [] sup)
       | -> ((!@loc, Anonymous), None), []  ] ]
   ;
+  hint_info:
+    [ [ "|"; i = OPT natural; pat = OPT constr_pattern ->
+         { hint_priority = i; hint_pattern = pat }
+      | -> { hint_priority = None; hint_pattern = None } ] ]
+  ;
   reserv_list:
     [ [ bl = LIST1 reserv_tuple -> bl | b = simple_reserv -> [b] ] ]
   ;
@@ -755,8 +820,8 @@ GEXTEND Gram
       (* Hack! Should be in grammar_ext, but camlp4 factorize badly *)
       | IDENT "Declare"; IDENT "Instance"; namesup = instance_name; ":";
 	 expl = [ "!" -> Decl_kinds.Implicit | -> Decl_kinds.Explicit ] ; t = operconstr LEVEL "200";
-	 pri = OPT [ "|"; i = natural -> i ] ->
-	   VernacInstance (true, snd namesup, (fst namesup, expl, t), None, pri)
+	 info = hint_info ->
+	   VernacInstance (true, snd namesup, (fst namesup, expl, t), None, info)
 
       (* System directory *)
       | IDENT "Pwd" -> VernacChdir None
@@ -812,7 +877,20 @@ GEXTEND Gram
 
       (* For acting on parameter tables *)
       | "Set"; table = option_table; v = option_value ->
-  	  VernacSetOption (table,v)
+        begin match v with
+        | StringValue s ->
+          (* We make a special case for warnings because appending is their
+          natural semantics *)
+          if CString.List.equal table ["Warnings"] then
+            VernacSetAppendOption (table, s)
+          else
+            let (last, prefix) = List.sep_last table in
+            if String.equal last "Append" && not (List.is_empty prefix) then
+              VernacSetAppendOption (prefix, s)
+            else
+              VernacSetOption (table, v)
+        | _ -> VernacSetOption (table, v)
+        end
       | "Set"; table = option_table ->
   	  VernacSetOption (table,BoolValue true)
       | IDENT "Unset"; table = option_table ->
@@ -841,7 +919,7 @@ GEXTEND Gram
 	  VernacRemoveOption ([table], v) ]] 
   ;
   query_command: (* TODO: rapprocher Eval et Check *)
-    [ [ IDENT "Eval"; r = Tactic.red_expr; "in"; c = lconstr ->
+    [ [ IDENT "Eval"; r = red_expr; "in"; c = lconstr ->
           fun g -> VernacCheckMayEval (Some r, g, c)
       | IDENT "Compute"; c = lconstr ->
 	  fun g -> VernacCheckMayEval (Some (Genredexpr.CbvVm None), g, c)
@@ -998,7 +1076,7 @@ GEXTEND Gram
 (* registration of a custom reduction *)
 
       | IDENT "Declare"; IDENT "Reduction"; s = IDENT; ":=";
-         r = Tactic.red_expr ->
+         r = red_expr ->
 	   VernacDeclareReduction (s,r)
 
  ] ];
@@ -1076,10 +1154,10 @@ GEXTEND Gram
       | IDENT "left"; IDENT "associativity" -> SetAssoc LeftA
       | IDENT "right"; IDENT "associativity" -> SetAssoc RightA
       | IDENT "no"; IDENT "associativity" -> SetAssoc NonA
-      | IDENT "only"; IDENT "parsing" ->
-        SetOnlyParsing Flags.Current
+      | IDENT "only"; IDENT "printing" -> SetOnlyPrinting
+      | IDENT "only"; IDENT "parsing" -> SetOnlyParsing
       | IDENT "compat"; s = STRING ->
-        SetOnlyParsing (Coqinit.get_compat_version s)
+        SetCompatVersion (Coqinit.get_compat_version s)
       | IDENT "format"; s1 = [s = STRING -> (!@loc,s)];
                         s2 = OPT [s = STRING -> (!@loc,s)] ->
           begin match s1, s2 with
diff --git a/parsing/highparsing.mllib b/parsing/highparsing.mllib
index 8df519b56..05e2911c2 100644
--- a/parsing/highparsing.mllib
+++ b/parsing/highparsing.mllib
@@ -2,4 +2,3 @@ G_constr
 G_vernac
 G_prim
 G_proofs
-G_tactic
diff --git a/parsing/pcoq.ml b/parsing/pcoq.ml
index efb89cd6e..c5823440a 100644
--- a/parsing/pcoq.ml
+++ b/parsing/pcoq.ml
@@ -8,7 +8,7 @@
 
 open Pp
 open Compat
-open Errors
+open CErrors
 open Util
 open Extend
 open Genarg
@@ -132,13 +132,13 @@ let grammar_delete e reinit (pos,rls) =
 let grammar_extend e reinit ext =
   let ext = of_coq_extend_statement ext in
   let undo () = grammar_delete e reinit ext in
-  let redo () = camlp4_verbose (maybe_uncurry (G.extend e)) ext in
+  let redo () = camlp4_verbosity false (maybe_uncurry (G.extend e)) ext in
   camlp4_state := ByEXTEND (undo, redo) :: !camlp4_state;
   redo ()
 
 let grammar_extend_sync e reinit ext =
   camlp4_state := ByGrammar (ExtendRule (e, reinit, ext)) :: !camlp4_state;
-  camlp4_verbose (maybe_uncurry (G.extend e)) (of_coq_extend_statement ext)
+  camlp4_verbosity false (maybe_uncurry (G.extend e)) (of_coq_extend_statement ext)
 
 (** The apparent parser of Coq; encapsulate G to keep track
     of the extensions. *)
@@ -264,7 +264,6 @@ module Prim =
     let preident = gec_gen "preident"
     let ident = gec_gen "ident"
     let natural = gec_gen "natural"
-    let index = gec_gen "index"
     let integer = gec_gen "integer"
     let bigint = Gram.entry_create "Prim.bigint"
     let string = gec_gen "string"
@@ -305,6 +304,7 @@ module Constr =
     let binder_constr = gec_constr "binder_constr"
     let ident = make_gen_entry uconstr "ident"
     let global = make_gen_entry uconstr "global"
+    let universe_level = make_gen_entry uconstr "universe_level"
     let sort = make_gen_entry uconstr "sort"
     let pattern = Gram.entry_create "constr:pattern"
     let constr_pattern = gec_constr "constr_pattern"
@@ -325,46 +325,6 @@ module Module =
     let module_type = Gram.entry_create "module_type"
   end
 
-module Tactic =
-  struct
-    (* Main entry for extensions *)
-    let simple_tactic = Gram.entry_create "tactic:simple_tactic"
-
-    (* Entries that can be referred via the string -> Gram.entry table *)
-    (* Typically for tactic user extensions *)
-    let open_constr =
-      make_gen_entry utactic "open_constr"
-    let constr_with_bindings =
-      make_gen_entry utactic "constr_with_bindings"
-    let bindings =
-      make_gen_entry utactic "bindings"
-    let hypident = Gram.entry_create "hypident"
-    let constr_may_eval = make_gen_entry utactic "constr_may_eval"
-    let constr_eval = make_gen_entry utactic "constr_eval"
-    let uconstr =
-      make_gen_entry utactic "uconstr"
-    let quantified_hypothesis =
-      make_gen_entry utactic "quantified_hypothesis"
-    let int_or_var = make_gen_entry utactic "int_or_var"
-    let red_expr = make_gen_entry utactic "red_expr"
-    let simple_intropattern =
-      make_gen_entry utactic "simple_intropattern"
-    let clause_dft_concl = 
-      make_gen_entry utactic "clause"
-
-
-    (* Main entries for ltac *)
-    let tactic_arg = Gram.entry_create "tactic:tactic_arg"
-    let tactic_expr = make_gen_entry utactic "tactic_expr"
-    let binder_tactic = make_gen_entry utactic "binder_tactic"
-
-    let tactic = make_gen_entry utactic "tactic"
-
-    (* Main entry for quotations *)
-    let tactic_eoi = eoi_entry tactic
-
-  end
-
 module Vernac_ =
   struct
     let gec_vernac s = Gram.entry_create ("vernac:" ^ s)
@@ -377,6 +337,8 @@ module Vernac_ =
     let vernac = gec_vernac "Vernac.vernac"
     let vernac_eoi = eoi_entry vernac
     let rec_definition = gec_vernac "Vernac.rec_definition"
+    let red_expr = make_gen_entry utactic "red_expr"
+    let hint_info = gec_vernac "hint_info"
     (* Main vernac entry *)
     let main_entry = Gram.entry_create "vernac"
     let noedit_mode = gec_vernac "noedit_command"
@@ -490,7 +452,7 @@ let with_grammar_rule_protection f x =
   let fs = freeze false in
   try let a = f x in unfreeze fs; a
   with reraise ->
-    let reraise = Errors.push reraise in
+    let reraise = CErrors.push reraise in
     let () = unfreeze fs in
     iraise reraise
 
@@ -498,26 +460,12 @@ let with_grammar_rule_protection f x =
 
 let () =
   let open Stdarg in
-  let open Constrarg in
-(*   Grammar.register0 wit_unit; *)
-(*   Grammar.register0 wit_bool; *)
   Grammar.register0 wit_int (Prim.integer);
   Grammar.register0 wit_string (Prim.string);
   Grammar.register0 wit_pre_ident (Prim.preident);
-  Grammar.register0 wit_int_or_var (Tactic.int_or_var);
-  Grammar.register0 wit_intro_pattern (Tactic.simple_intropattern);
   Grammar.register0 wit_ident (Prim.ident);
   Grammar.register0 wit_var (Prim.var);
   Grammar.register0 wit_ref (Prim.reference);
-  Grammar.register0 wit_quant_hyp (Tactic.quantified_hypothesis);
   Grammar.register0 wit_constr (Constr.constr);
-  Grammar.register0 wit_uconstr (Tactic.uconstr);
-  Grammar.register0 wit_open_constr (Tactic.open_constr);
-  Grammar.register0 wit_constr_with_bindings (Tactic.constr_with_bindings);
-  Grammar.register0 wit_bindings (Tactic.bindings);
-(*   Grammar.register0 wit_hyp_location_flag; *)
-  Grammar.register0 wit_red_expr (Tactic.red_expr);
-  Grammar.register0 wit_tactic (Tactic.tactic);
-  Grammar.register0 wit_ltac (Tactic.tactic);
-  Grammar.register0 wit_clause_dft_concl (Tactic.clause_dft_concl);
+  Grammar.register0 wit_red_expr (Vernac_.red_expr);
   ()
diff --git a/parsing/pcoq.mli b/parsing/pcoq.mli
index 319ca256e..d987bb455 100644
--- a/parsing/pcoq.mli
+++ b/parsing/pcoq.mli
@@ -12,7 +12,6 @@ open Extend
 open Vernacexpr
 open Genarg
 open Constrexpr
-open Tacexpr
 open Libnames
 open Misctypes
 open Genredexpr
@@ -39,7 +38,7 @@ module Gram : module type of Compat.GrammarMake(CLexer)
         |     (together with a constr entry level, e.g. 50, and indications of)
         |     (subentries, e.g. x in constr next level and y constr same level)
         |
-        | spliting into tokens by Metasyntax.split_notation_string
+        | splitting into tokens by Metasyntax.split_notation_string
         V
       [String "x"; String "+"; String "y"] : symbol_token list
         |
@@ -96,7 +95,7 @@ module Gram : module type of Compat.GrammarMake(CLexer)
 
 *)
 
-(** Temporary activate camlp4 verbosity *)
+(** Temporarily activate camlp4 verbosity *)
 
 val camlp4_verbosity : bool -> ('a -> unit) -> 'a -> unit
 
@@ -134,7 +133,6 @@ module Prim :
     val pattern_identref : Id.t located Gram.entry
     val base_ident : Id.t Gram.entry
     val natural : int Gram.entry
-    val index : int Gram.entry
     val bigint : Bigint.bigint Gram.entry
     val integer : int Gram.entry
     val string : string Gram.entry
@@ -158,6 +156,7 @@ module Constr :
     val operconstr : constr_expr Gram.entry
     val ident : Id.t Gram.entry
     val global : reference Gram.entry
+    val universe_level : glob_level Gram.entry
     val sort : glob_sort Gram.entry
     val pattern : cases_pattern_expr Gram.entry
     val constr_pattern : constr_expr Gram.entry
@@ -178,28 +177,6 @@ module Module :
     val module_type : module_ast Gram.entry
   end
 
-module Tactic :
-  sig
-    val open_constr : constr_expr Gram.entry
-    val constr_with_bindings : constr_expr with_bindings Gram.entry
-    val bindings : constr_expr bindings Gram.entry
-    val hypident : (Id.t located * Locus.hyp_location_flag) Gram.entry
-    val constr_may_eval : (constr_expr,reference or_by_notation,constr_expr) may_eval Gram.entry
-    val constr_eval : (constr_expr,reference or_by_notation,constr_expr) may_eval Gram.entry
-    val uconstr : constr_expr Gram.entry
-    val quantified_hypothesis : quantified_hypothesis Gram.entry
-    val int_or_var : int or_var Gram.entry
-    val red_expr : raw_red_expr Gram.entry
-    val simple_tactic : raw_tactic_expr Gram.entry
-    val simple_intropattern : constr_expr intro_pattern_expr located Gram.entry
-    val clause_dft_concl : Names.Id.t Loc.located Locus.clause_expr Gram.entry
-    val tactic_arg : raw_tactic_arg Gram.entry
-    val tactic_expr : raw_tactic_expr Gram.entry
-    val binder_tactic : raw_tactic_expr Gram.entry
-    val tactic : raw_tactic_expr Gram.entry
-    val tactic_eoi : raw_tactic_expr Gram.entry
-  end
-
 module Vernac_ :
   sig
     val gallina : vernac_expr Gram.entry
@@ -211,6 +188,8 @@ module Vernac_ :
     val vernac_eoi : vernac_expr Gram.entry
     val noedit_mode : vernac_expr Gram.entry
     val command_entry : vernac_expr Gram.entry
+    val red_expr : raw_red_expr Gram.entry
+    val hint_info : Vernacexpr.hint_info_expr Gram.entry
   end
 
 (** The main entry: reads an optional vernac command *)
@@ -229,14 +208,14 @@ type gram_reinit = gram_assoc * gram_position
 
 val grammar_extend : 'a Gram.entry -> gram_reinit option ->
   'a Extend.extend_statment -> unit
-(** Extend the grammar of Coq, without synchronizing it with the bactracking
+(** Extend the grammar of Coq, without synchronizing it with the backtracking
     mechanism. This means that grammar extensions defined this way will survive
     an undo. *)
 
 (** {5 Extending the parser with summary-synchronized commands} *)
 
 module GramState : Store.S
-(** Auxilliary state of the grammar. Any added data must be marshallable. *)
+(** Auxiliary state of the grammar. Any added data must be marshallable. *)
 
 type 'a grammar_command
 (** Type of synchronized parsing extensions. The ['a] type should be
diff --git a/parsing/tok.ml b/parsing/tok.ml
index df7e7c2a6..f4b60aeec 100644
--- a/parsing/tok.ml
+++ b/parsing/tok.ml
@@ -16,7 +16,6 @@ type t =
   | IDENT of string
   | FIELD of string
   | INT of string
-  | INDEX of string
   | STRING of string
   | LEFTQMARK
   | BULLET of string
@@ -29,7 +28,6 @@ let equal t1 t2 = match t1, t2 with
 | IDENT s1, IDENT s2 -> string_equal s1 s2
 | FIELD s1, FIELD s2 -> string_equal s1 s2
 | INT s1, INT s2 -> string_equal s1 s2
-| INDEX s1, INDEX s2 -> string_equal s1 s2
 | STRING s1, STRING s2 -> string_equal s1 s2
 | LEFTQMARK, LEFTQMARK -> true
 | BULLET s1, BULLET s2 -> string_equal s1 s2
@@ -43,7 +41,6 @@ let extract_string = function
   | PATTERNIDENT s -> s
   | FIELD s -> s
   | INT s -> s
-  | INDEX s -> s
   | LEFTQMARK -> "?"
   | BULLET s -> s
   | EOI -> ""
@@ -54,10 +51,9 @@ let to_string = function
   | PATTERNIDENT s -> Format.sprintf "PATTERNIDENT %S" s
   | FIELD s -> Format.sprintf "FIELD %S" s
   | INT s -> Format.sprintf "INT %s" s
-  | INDEX s -> Format.sprintf "INDEX %s" s
   | STRING s -> Format.sprintf "STRING %S" s
   | LEFTQMARK -> "LEFTQMARK"
-  | BULLET s -> Format.sprintf "STRING %S" s
+  | BULLET s -> Format.sprintf "BULLET %S" s
   | EOI -> "EOI"
 
 let match_keyword kwd = function
@@ -77,7 +73,6 @@ let of_pattern = function
   | "PATTERNIDENT", s -> PATTERNIDENT s
   | "FIELD", s -> FIELD s
   | "INT", s -> INT s
-  | "INDEX", s -> INDEX s
   | "STRING", s -> STRING s
   | "LEFTQMARK", _ -> LEFTQMARK
   | "BULLET", s -> BULLET s
@@ -90,7 +85,6 @@ let to_pattern = function
   | PATTERNIDENT s -> "PATTERNIDENT", s
   | FIELD s -> "FIELD", s
   | INT s -> "INT", s
-  | INDEX s -> "INDEX", s
   | STRING s -> "STRING", s
   | LEFTQMARK -> "LEFTQMARK", ""
   | BULLET s -> "BULLET", s
@@ -104,7 +98,6 @@ let match_pattern =
     | "PATTERNIDENT", "" -> (function PATTERNIDENT s -> s | _ -> err ())
     | "FIELD", "" -> (function FIELD s -> s | _ -> err ())
     | "INT", "" -> (function INT s -> s | _ -> err ())
-    | "INDEX", "" -> (function INDEX s -> s | _ -> err ())
     | "STRING", "" -> (function STRING s -> s | _ -> err ())
     | "LEFTQMARK", "" -> (function LEFTQMARK -> ""  | _ -> err ())
     | "BULLET", "" ->  (function BULLET s -> s  | _ -> err ())
diff --git a/parsing/tok.mli b/parsing/tok.mli
index 54b747952..b9286c53e 100644
--- a/parsing/tok.mli
+++ b/parsing/tok.mli
@@ -14,7 +14,6 @@ type t =
   | IDENT of string
   | FIELD of string
   | INT of string
-  | INDEX of string
   | STRING of string
   | LEFTQMARK
   | BULLET of string
diff --git a/plugins/btauto/btauto_plugin.mllib b/plugins/btauto/btauto_plugin.mlpack
index 319a9c302..2410f906a 100644
--- a/plugins/btauto/btauto_plugin.mllib
+++ b/plugins/btauto/btauto_plugin.mlpack
@@ -1,3 +1,2 @@
 Refl_btauto
 G_btauto
-Btauto_plugin_mod
diff --git a/plugins/btauto/refl_btauto.ml b/plugins/btauto/refl_btauto.ml
index aee0bd856..2c5b108e5 100644
--- a/plugins/btauto/refl_btauto.ml
+++ b/plugins/btauto/refl_btauto.ml
@@ -15,7 +15,7 @@ let get_inductive dir s =
   Lazy.from_fun (fun () -> Globnames.destIndRef (glob_ref ()))
 
 let decomp_term (c : Term.constr) =
-  Term.kind_of_term (Term.strip_outer_cast c)
+  Term.kind_of_term (Termops.strip_outer_cast c)
 
 let lapp c v  = Term.mkApp (Lazy.force c, v)
 
@@ -212,7 +212,7 @@ module Btauto = struct
         let assign = List.map map_msg assign in
         let l = str "[" ++ (concat (str ";" ++ spc ()) assign) ++ str "]" in
         str "Not a tautology:" ++ spc () ++ l
-      with e when Errors.noncritical e -> (str "Not a tautology")
+      with e when CErrors.noncritical e -> (str "Not a tautology")
     in
     Tacticals.tclFAIL 0 msg gl
 
diff --git a/plugins/cc/cc_plugin.mllib b/plugins/cc/cc_plugin.mlpack
index 1bcfc5378..27e903fd3 100644
--- a/plugins/cc/cc_plugin.mllib
+++ b/plugins/cc/cc_plugin.mlpack
@@ -2,4 +2,3 @@ Ccalgo
 Ccproof
 Cctac
 G_congruence
-Cc_plugin_mod
diff --git a/plugins/cc/ccalgo.ml b/plugins/cc/ccalgo.ml
index 76db2f3c2..7347c3c2c 100644
--- a/plugins/cc/ccalgo.ml
+++ b/plugins/cc/ccalgo.ml
@@ -10,7 +10,7 @@
 (* Downey,Sethi and Tarjan. *)
 (* Plus some e-matching and constructor handling by P. Corbineau *)
 
-open Errors
+open CErrors
 open Util
 open Pp
 open Goptions
@@ -444,7 +444,7 @@ and applist_projection c l =
     let p = Projection.make (fst c) false in
     (match l with 
     | [] -> (* Expand the projection *)
-      let ty,_ = Typeops.type_of_constant (Global.env ()) c in
+      let ty = Typeops.type_of_constant_in (Global.env ()) c in (* FIXME constraints *)
       let pb = Environ.lookup_projection p (Global.env()) in
       let ctx,_ = Term.decompose_prod_n_assum (pb.Declarations.proj_npars + 1) ty in
 	it_mkLambda_or_LetIn (mkProj(p,mkRel 1)) ctx
@@ -484,7 +484,7 @@ let build_subst uf subst =
   Array.map
     (fun i ->
       try term uf i
-      with e when Errors.noncritical e ->
+      with e when CErrors.noncritical e ->
         anomaly (Pp.str "incomplete matching"))
     subst
 
diff --git a/plugins/cc/ccproof.ml b/plugins/cc/ccproof.ml
index d2bbaf6a7..f58847caf 100644
--- a/plugins/cc/ccproof.ml
+++ b/plugins/cc/ccproof.ml
@@ -9,7 +9,7 @@
 (* This file uses the (non-compressed) union-find structure to generate *)
 (* proof-trees that will be transformed into proof-terms in cctac.ml4   *)
 
-open Errors
+open CErrors
 open Term
 open Ccalgo
 open Pp
diff --git a/plugins/cc/cctac.ml b/plugins/cc/cctac.ml
index bd788a425..b5ca2f50f 100644
--- a/plugins/cc/cctac.ml
+++ b/plugins/cc/cctac.ml
@@ -20,10 +20,12 @@ open Typing
 open Ccalgo
 open Ccproof
 open Pp
-open Errors
+open CErrors
 open Util
 open Proofview.Notations
-open Context.Rel.Declaration
+
+module RelDecl = Context.Rel.Declaration
+module NamedDecl = Context.Named.Declaration
 
 let reference dir s = lazy (Coqlib.gen_reference "CC" dir s)
 
@@ -38,12 +40,12 @@ let _True = reference ["Init";"Logic"] "True"
 let _I = reference ["Init";"Logic"] "I"
 
 let whd env=
-  let infos=Closure.create_clos_infos Closure.betaiotazeta env in
-    (fun t -> Closure.whd_val infos (Closure.inject t))
+  let infos=CClosure.create_clos_infos CClosure.betaiotazeta env in
+    (fun t -> CClosure.whd_val infos (CClosure.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 infos=CClosure.create_clos_infos CClosure.all env in
+    (fun t -> CClosure.whd_val infos (CClosure.inject t))
 
 (* decompose member of equality in an applicative format *)
 
@@ -82,8 +84,10 @@ let rec decompose_term env sigma t=
     | Proj (p, c) -> 
 	let canon_const kn = constant_of_kn (canonical_con kn) in 
 	let p' = Projection.map canon_const p in
-	  (Appli (Symb (mkConst (Projection.constant p')), decompose_term env sigma c))
-    | _ ->if closed0 t then (Symb t) else raise Not_found
+	(Appli (Symb (mkConst (Projection.constant p')), decompose_term env sigma c))
+    | _ ->
+       let t = Termops.strip_outer_cast t in
+       if closed0 t then Symb t else raise Not_found
 
 (* decompose equality in members and type *)
 open Globnames
@@ -153,7 +157,7 @@ let rec quantified_atom_of_constr env sigma nrels term =
 	  let patts=patterns_of_constr env sigma nrels atom in
 	      `Nrule patts
 	else 
-	  quantified_atom_of_constr (Environ.push_rel (LocalAssum (id,atom)) env) sigma (succ nrels) ff
+	  quantified_atom_of_constr (Environ.push_rel (RelDecl.LocalAssum (id,atom)) env) sigma (succ nrels) ff
     | _ ->  
 	let patts=patterns_of_constr env sigma nrels term in
 	    `Rule patts
@@ -168,7 +172,7 @@ let litteral_of_constr env sigma term=
 	else
 	  begin
 	    try 
-	      quantified_atom_of_constr (Environ.push_rel (LocalAssum (id,atom)) env) sigma 1 ff
+	      quantified_atom_of_constr (Environ.push_rel (RelDecl.LocalAssum (id,atom)) env) sigma 1 ff
 	    with Not_found ->
 	      `Other (decompose_term env sigma term)
 	  end
@@ -190,10 +194,10 @@ let make_prb gls depth additionnal_terms =
 	   ignore (add_term state t)) additionnal_terms;
     List.iter
       (fun decl ->
-         let (id,_,e) = Context.Named.Declaration.to_tuple decl in
+         let id = NamedDecl.get_id decl in
 	 begin
 	   let cid=mkVar id in
-	   match litteral_of_constr env sigma e with
+	   match litteral_of_constr env sigma (NamedDecl.get_type decl) with
 	       `Eq (t,a,b) -> add_equality state cid a b
 	     | `Neq (t,a,b) -> add_disequality state (Hyp cid) a b
 	     | `Other ph ->
@@ -233,10 +237,10 @@ let build_projection intype (cstr:pconstructor) special default gls=
 
 let _M =mkMeta
 
-let app_global f args k = 
+let app_global f args k =
   Tacticals.pf_constr_of_global (Lazy.force f) (fun fc -> k (mkApp (fc, args)))
 
-let new_app_global f args k = 
+let new_app_global f args k =
   Tacticals.New.pf_constr_of_global (Lazy.force f) (fun fc -> k (mkApp (fc, args)))
 
 let new_refine c = Proofview.V82.tactic (refine c)
@@ -246,7 +250,19 @@ let assert_before n c =
     let evm, _ = Tacmach.New.pf_apply type_of gl c in
       Tacticals.New.tclTHEN (Proofview.V82.tactic (Refiner.tclEVARS evm)) (assert_before n c)
   end }
-    
+
+let refresh_type env evm ty =
+  Evarsolve.refresh_universes ~status:Evd.univ_flexible ~refreshset:true
+			      (Some false) env evm ty
+
+let refresh_universes ty k =
+  Proofview.Goal.enter { enter = begin fun gl ->
+    let env = Proofview.Goal.env gl in
+    let evm = Tacmach.New.project gl in
+    let evm, ty = refresh_type env evm ty in
+    Tacticals.New.tclTHEN (Proofview.V82.tactic (Refiner.tclEVARS evm)) (k ty)
+  end }
+
 let rec proof_tac p : unit Proofview.tactic =
   Proofview.Goal.nf_enter { enter = begin fun gl ->
   let type_of t = Tacmach.New.pf_unsafe_type_of gl t in
@@ -256,35 +272,31 @@ let rec proof_tac p : unit Proofview.tactic =
     | SymAx c ->
 	let l=constr_of_term p.p_lhs and
 	    r=constr_of_term p.p_rhs in
-        let typ = (* Termops.refresh_universes *) type_of l in
-        new_app_global _sym_eq [|typ;r;l;c|] exact_check
+	refresh_universes (type_of l) (fun typ ->
+        new_app_global _sym_eq [|typ;r;l;c|] exact_check)
     | Refl t ->
 	let lr = constr_of_term t in
-	let typ = (* Termops.refresh_universes *) type_of lr in
-        new_app_global _refl_equal [|typ;constr_of_term t|] exact_check
+	refresh_universes (type_of lr) (fun typ ->
+        new_app_global _refl_equal [|typ;constr_of_term t|] exact_check)
     | Trans (p1,p2)->
 	let t1 = constr_of_term p1.p_lhs and
 	    t2 = constr_of_term p1.p_rhs and
 	    t3 = constr_of_term p2.p_rhs in
-	let typ = (* Termops.refresh_universes *) (type_of t2) in
+	refresh_universes (type_of t2) (fun typ ->
 	let prf = new_app_global _trans_eq [|typ;t1;t2;t3;_M 1;_M 2|] in
-          Tacticals.New.tclTHENS (prf new_refine) [(proof_tac p1);(proof_tac p2)]
+          Tacticals.New.tclTHENS (prf new_refine) [(proof_tac p1);(proof_tac p2)])
     | Congr (p1,p2)->
 	let tf1=constr_of_term p1.p_lhs
 	and tx1=constr_of_term p2.p_lhs
 	and tf2=constr_of_term p1.p_rhs
 	and tx2=constr_of_term p2.p_rhs in
-	let typf = (* Termops.refresh_universes  *)(type_of tf1) in
-	let typx = (* Termops.refresh_universes *) (type_of tx1) in
-	let typfx = (* Termops.refresh_universes *) (type_of (mkApp (tf1,[|tx1|]))) in
+	refresh_universes (type_of tf1) (fun typf ->
+	refresh_universes (type_of tx1) (fun typx ->
+	refresh_universes (type_of (mkApp (tf1,[|tx1|]))) (fun typfx ->
         let id = Tacmach.New.of_old (fun gls -> pf_get_new_id (Id.of_string "f") gls) gl in
 	let appx1 = mkLambda(Name id,typf,mkApp(mkRel 1,[|tx1|])) in
-	let lemma1 =
-	  app_global _f_equal
-		[|typf;typfx;appx1;tf1;tf2;_M 1|] in
-	let lemma2=
-	  app_global _f_equal
-		[|typx;typfx;tf2;tx1;tx2;_M 1|] in
+	let lemma1 = app_global _f_equal [|typf;typfx;appx1;tf1;tf2;_M 1|] in
+	let lemma2 = app_global _f_equal [|typx;typfx;tf2;tx1;tx2;_M 1|] in
 	let prf =
 	  app_global _trans_eq
 		[|typfx;
@@ -298,34 +310,33 @@ let rec proof_tac p : unit Proofview.tactic =
 		reflexivity;
                 Tacticals.New.tclZEROMSG
 		    (Pp.str
-		       "I don't know how to handle dependent equality")]]
+		       "I don't know how to handle dependent equality")]])))
   | Inject (prf,cstr,nargs,argind) ->
 	 let ti=constr_of_term prf.p_lhs in
 	 let tj=constr_of_term prf.p_rhs in
 	 let default=constr_of_term p.p_lhs in
-	 let intype = (* Termops.refresh_universes *) (type_of ti) in
-	 let outtype = (* Termops.refresh_universes *) (type_of default) in
 	 let special=mkRel (1+nargs-argind) in
+	 refresh_universes (type_of ti) (fun intype ->
+         refresh_universes (type_of default) (fun outtype ->
          let proj =
            Tacmach.New.of_old (build_projection intype cstr special default) gl
          in
 	 let injt=
            app_global _f_equal [|intype;outtype;proj;ti;tj;_M 1|] in
-	   Tacticals.New.tclTHEN (Proofview.V82.tactic (injt refine)) (proof_tac prf)
+	   Tacticals.New.tclTHEN (Proofview.V82.tactic (injt refine)) (proof_tac prf)))
   with e when Proofview.V82.catchable_exception e -> Proofview.tclZERO e
   end }
 
 let refute_tac c t1 t2 p =
   Proofview.Goal.nf_enter { enter = begin fun gl ->
   let tt1=constr_of_term t1 and tt2=constr_of_term t2 in
-  let intype =
-    Tacmach.New.of_old (fun gls -> (* Termops.refresh_universes *) (pf_unsafe_type_of gls tt1)) gl
-  in
-  let neweq= new_app_global _eq [|intype;tt1;tt2|] in
   let hid = Tacmach.New.of_old (pf_get_new_id (Id.of_string "Heq")) gl in
   let false_t=mkApp (c,[|mkVar hid|]) in
+  let k intype =
+    let neweq= new_app_global _eq [|intype;tt1;tt2|] in
     Tacticals.New.tclTHENS (neweq (assert_before (Name hid)))
       [proof_tac p; simplest_elim false_t]
+  in refresh_universes (Tacmach.New.pf_unsafe_type_of gl tt1) k
   end }
 
 let refine_exact_check c gl =
@@ -335,16 +346,15 @@ let refine_exact_check c gl =
 let convert_to_goal_tac c t1 t2 p = 
   Proofview.Goal.nf_enter { enter = begin fun gl ->
   let tt1=constr_of_term t1 and tt2=constr_of_term t2 in
-  let sort =
-    Tacmach.New.of_old (fun gls -> (* Termops.refresh_universes *) (pf_unsafe_type_of gls tt2)) gl
-  in
-  let neweq= new_app_global _eq [|sort;tt1;tt2|] in
-  let e = Tacmach.New.of_old (pf_get_new_id (Id.of_string "e")) gl in
-  let x = Tacmach.New.of_old (pf_get_new_id (Id.of_string "X")) gl in
-  let identity=mkLambda (Name x,sort,mkRel 1) in
-  let endt=app_global _eq_rect [|sort;tt1;identity;c;tt2;mkVar e|] in
+  let k sort =
+    let neweq= new_app_global _eq [|sort;tt1;tt2|] in
+    let e = Tacmach.New.of_old (pf_get_new_id (Id.of_string "e")) gl in
+    let x = Tacmach.New.of_old (pf_get_new_id (Id.of_string "X")) gl in
+    let identity=mkLambda (Name x,sort,mkRel 1) in
+    let endt=app_global _eq_rect [|sort;tt1;identity;c;tt2;mkVar e|] in
     Tacticals.New.tclTHENS (neweq (assert_before (Name e)))
-      [proof_tac p; Proofview.V82.tactic (endt refine_exact_check)]
+			   [proof_tac p; Proofview.V82.tactic (endt refine_exact_check)]
+  in refresh_universes (Tacmach.New.pf_unsafe_type_of gl tt2) k
   end }
 
 let convert_to_hyp_tac c1 t1 c2 t2 p =
@@ -360,33 +370,28 @@ let convert_to_hyp_tac c1 t1 c2 t2 p =
 let discriminate_tac (cstr,u as cstru) p =
   Proofview.Goal.nf_enter { enter = begin fun gl ->
     let t1=constr_of_term p.p_lhs and t2=constr_of_term p.p_rhs in
-    let intype =
-      Tacmach.New.of_old (fun gls -> (* Termops.refresh_universes *) (pf_unsafe_type_of gls t1)) gl
-    in
+    let env = Proofview.Goal.env gl in
     let concl = Proofview.Goal.concl gl in
-    (* let evm,outsort = Evd.new_sort_variable Evd.univ_rigid (project gls) in  *)
-    (* let outsort = mkSort outsort in *)
     let xid = Tacmach.New.of_old (pf_get_new_id (Id.of_string "X")) gl in
-    (* let tid = Tacmach.New.of_old (pf_get_new_id (Id.of_string "t")) gl in *)
-    (* let identity=mkLambda(Name xid,outsort,mkLambda(Name tid,mkRel 1,mkRel 1)) in *)
     let identity = Universes.constr_of_global (Lazy.force _I) in
-    (* let trivial=pf_unsafe_type_of gls identity in *)
     let trivial = Universes.constr_of_global (Lazy.force _True) in
-    let evm, outtype = Evd.new_sort_variable Evd.univ_flexible (Tacmach.New.project gl) in 
+    let evm = Tacmach.New.project gl in
+    let evm, intype = refresh_type env evm (Tacmach.New.pf_unsafe_type_of gl t1) in
+    let evm, outtype = Evd.new_sort_variable Evd.univ_flexible evm in
     let outtype = mkSort outtype in
-    let pred=mkLambda(Name xid,outtype,mkRel 1) in
+    let pred = mkLambda(Name xid,outtype,mkRel 1) in
     let hid = Tacmach.New.of_old (pf_get_new_id (Id.of_string "Heq")) gl in
     let proj = Tacmach.New.of_old (build_projection intype cstru trivial concl) gl in
     let injt=app_global _f_equal
-                    [|intype;outtype;proj;t1;t2;mkVar hid|] in
+			[|intype;outtype;proj;t1;t2;mkVar hid|] in
     let endt k =
       injt (fun injt ->
-        app_global _eq_rect
-          [|outtype;trivial;pred;identity;concl;injt|] k) in
+            app_global _eq_rect
+		       [|outtype;trivial;pred;identity;concl;injt|] k) in
     let neweq=new_app_global _eq [|intype;t1;t2|] in
     Tacticals.New.tclTHEN (Proofview.Unsafe.tclEVARS evm)
-      (Tacticals.New.tclTHENS (neweq (assert_before (Name hid)))
-        [proof_tac p; Proofview.V82.tactic (endt refine_exact_check)])
+			  (Tacticals.New.tclTHENS (neweq (assert_before (Name hid)))
+      [proof_tac p; Proofview.V82.tactic (endt refine_exact_check)])
   end }
 
 (* wrap everything *)
@@ -453,7 +458,7 @@ let cc_tactic depth additionnal_terms =
   end }
 
 let cc_fail gls =
-  errorlabstrm  "Congruence" (Pp.str "congruence failed.")
+  user_err ~hdr:"Congruence" (Pp.str "congruence failed.")
 
 let congruence_tac depth l =
   Tacticals.New.tclORELSE
@@ -470,7 +475,7 @@ let congruence_tac depth l =
    This isn't particularly related with congruence, apart from
    the fact that congruence is called internally.
 *)
-    
+
 let mk_eq f c1 c2 k =
   Tacticals.New.pf_constr_of_global (Lazy.force f) (fun fc ->
   Proofview.Goal.enter { enter = begin fun gl ->
@@ -482,7 +487,7 @@ let mk_eq f c1 c2 k =
     Tacticals.New.tclTHEN (Proofview.V82.tactic (Refiner.tclEVARS evm))
 			  (k term)
     end })
-    
+
 let f_equal =
   Proofview.Goal.nf_enter { enter = begin fun gl ->
     let concl = Proofview.Goal.concl gl in
diff --git a/plugins/cc/g_congruence.ml4 b/plugins/cc/g_congruence.ml4
index 52a135119..6f6811334 100644
--- a/plugins/cc/g_congruence.ml4
+++ b/plugins/cc/g_congruence.ml4
@@ -10,7 +10,6 @@
 
 open Cctac
 open Stdarg
-open Constrarg
 
 DECLARE PLUGIN "cc_plugin"
 
diff --git a/plugins/decl_mode/decl_interp.ml b/plugins/decl_mode/decl_interp.ml
index 34307a358..f68c01b18 100644
--- a/plugins/decl_mode/decl_interp.ml
+++ b/plugins/decl_mode/decl_interp.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-open Errors
+open CErrors
 open Util
 open Names
 open Constrexpr
@@ -90,8 +90,8 @@ let rec add_vars_of_simple_pattern globs = function
 (*      Loc.raise loc
 	(UserError ("simple_pattern",str "\"as\" is not allowed here"))*)
   | CPatOr (loc, _)->
-      Loc.raise loc
-	(UserError ("simple_pattern",str "\"(_ | _)\" is not allowed here"))
+      Loc.raise ~loc
+	(UserError (Some "simple_pattern",str "\"(_ | _)\" is not allowed here"))
   | CPatDelimiters (_,_,p) ->
       add_vars_of_simple_pattern globs p
   | CPatCstr (_,_,pl1,pl2) ->
@@ -153,8 +153,8 @@ let interp_constr check_sort env sigma c =
     fst (understand env sigma (fst c))
 
 let special_whd env =
-  let infos=Closure.create_clos_infos Closure.betadeltaiota env in
-    (fun t -> Closure.whd_val infos (Closure.inject t))
+  let infos=CClosure.create_clos_infos CClosure.all env in
+    (fun t -> CClosure.whd_val infos (CClosure.inject t))
 
 let _eq = lazy (Universes.constr_of_global (Coqlib.glob_eq))
 
@@ -328,7 +328,7 @@ let interp_cases info env sigma params (pat:cases_pattern_expr) hyps =
   let _ =
     let expected = mib.Declarations.mind_nparams - num_params in
       if not (Int.equal (List.length params) expected) then
-	errorlabstrm "suppose it is" 
+	user_err ~hdr:"suppose it is" 
 	  (str "Wrong number of extra arguments: " ++ 
 	     (if Int.equal expected 0 then str "none" else int expected) ++ spc () ++
 	     str "expected.") in
@@ -348,7 +348,7 @@ let interp_cases info env sigma params (pat:cases_pattern_expr) hyps =
       Thesis (Plain) -> Glob_term.GSort(Loc.ghost,GProp)
     | Thesis (For rec_occ) ->
 	if not (Id.List.mem rec_occ pat_vars) then
-	  errorlabstrm "suppose it is"
+	  user_err ~hdr:"suppose it is"
 	    (str "Variable " ++ Nameops.pr_id rec_occ ++
 	       str " does not occur in pattern.");
 	Glob_term.GSort(Loc.ghost,GProp)
diff --git a/plugins/decl_mode/decl_mode.ml b/plugins/decl_mode/decl_mode.ml
index f9399d682..92d408901 100644
--- a/plugins/decl_mode/decl_mode.ml
+++ b/plugins/decl_mode/decl_mode.ml
@@ -9,7 +9,7 @@
 open Names
 open Term
 open Evd
-open Errors
+open CErrors
 open Util
 
 let daimon_flag = ref false
diff --git a/plugins/decl_mode/decl_mode_plugin.mllib b/plugins/decl_mode/decl_mode_plugin.mlpack
index 39342dbd1..1b84a0790 100644
--- a/plugins/decl_mode/decl_mode_plugin.mllib
+++ b/plugins/decl_mode/decl_mode_plugin.mlpack
@@ -3,4 +3,3 @@ Decl_interp
 Decl_proof_instr
 Ppdecl_proof
 G_decl_mode
-Decl_mode_plugin_mod
diff --git a/plugins/decl_mode/decl_proof_instr.ml b/plugins/decl_mode/decl_proof_instr.ml
index 3fa600ac2..e19dc86c4 100644
--- a/plugins/decl_mode/decl_proof_instr.ml
+++ b/plugins/decl_mode/decl_proof_instr.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-open Errors
+open CErrors
 open Util
 open Pp
 open Evd
@@ -32,6 +32,9 @@ open Misctypes
 open Sigma.Notations
 open Context.Named.Declaration
 
+module RelDecl = Context.Rel.Declaration
+module NamedDecl = Context.Named.Declaration
+
 (* Strictness option *)
 
 let clear ids { it = goal; sigma } =
@@ -43,7 +46,7 @@ let clear ids { it = goal; sigma } =
   let (hyps, concl) =
     try Evarutil.clear_hyps_in_evi env evdref sign cl ids
     with Evarutil.ClearDependencyError (id, _) ->
-      errorlabstrm "" (str "Cannot clear " ++ pr_id id)
+      user_err  (str "Cannot clear " ++ pr_id id)
   in
   let sigma = !evdref in
   let (gl,ev,sigma) = Goal.V82.mk_goal sigma hyps concl (Goal.V82.extra sigma goal) in
@@ -60,7 +63,7 @@ let _ =
   declare_bool_option
     { optsync  = true;
       optdepr  = false;
-      optname  = "strict mode";
+      optname  = "strict proofs";
       optkey   = ["Strict";"Proofs"];
       optread  = get_strictness;
       optwrite = set_strictness }
@@ -84,12 +87,12 @@ let tcl_erase_info gls =
   tcl_change_info_gen info_gen gls
 
 let special_whd gl=
-  let infos=Closure.create_clos_infos Closure.betadeltaiota (pf_env gl) in
-    (fun t -> Closure.whd_val infos (Closure.inject t))
+  let infos=CClosure.create_clos_infos CClosure.all (pf_env gl) in
+    (fun t -> CClosure.whd_val infos (CClosure.inject t))
 
 let special_nf gl=
-  let infos=Closure.create_clos_infos Closure.betaiotazeta (pf_env gl) in
-    (fun t -> Closure.norm_val infos (Closure.inject t))
+  let infos=CClosure.create_clos_infos CClosure.betaiotazeta (pf_env gl) in
+    (fun t -> CClosure.norm_val infos (CClosure.inject t))
 
 let is_good_inductive env ind =
   let mib,oib = Inductive.lookup_mind_specif env ind in
@@ -247,7 +250,7 @@ let close_previous_case pts =
 
 let filter_hyps f gls =
   let filter_aux id =
-    let id = get_id id in
+    let id = NamedDecl.get_id id in
     if f id then
       tclIDTAC
     else
@@ -277,12 +280,16 @@ let prepare_goal items gls =
        filter_hyps (let keep = !tokeep in fun id -> Id.Set.mem id keep)] gls
 
 let my_automation_tac = ref
-  (Proofview.tclZERO (Errors.make_anomaly (Pp.str"No automation registered")))
+  (Proofview.tclZERO (CErrors.make_anomaly (Pp.str"No automation registered")))
 
 let register_automation_tac tac = my_automation_tac:= tac
 
 let automation_tac = Proofview.tclBIND (Proofview.tclUNIT ()) (fun () -> !my_automation_tac)
 
+let warn_insufficient_justification =
+  CWarnings.create ~name:"declmode-insufficient-justification" ~category:"declmode"
+    (fun () -> strbrk "Insufficient justification.")
+
 let justification tac gls=
     tclORELSE
       (tclSOLVE [tclTHEN tac (Proofview.V82.of_tactic assumption)])
@@ -291,7 +298,7 @@ let justification tac gls=
 	   error "Insufficient justification."
 	 else
 	   begin
-	     Feedback.msg_warning (str "Insufficient justification.");
+             warn_insufficient_justification ();
 	     daimon_tac gls
 	   end) gls
 
@@ -353,8 +360,7 @@ let enstack_subsubgoals env se stack gls=
 		  let nlast=succ last in
 		  let (llast,holes,metas) =
 		    meta_aux nlast (mkMeta nlast :: lenv) q in
-                    let open Context.Rel.Declaration in
-		    (llast,holes,(nlast,special_nf gls (substl lenv (get_type decl)))::metas) in
+		    (llast,holes,(nlast,special_nf gls (substl lenv (RelDecl.get_type decl)))::metas) in
 	    let (nlast,holes,nmetas) =
 		meta_aux se.se_last_meta [] (List.rev rc) in
 	    let refiner = applist (appterm,List.rev holes) in
@@ -411,7 +417,7 @@ let find_subsubgoal c ctyp skip submetas gls =
 		  se.se_meta submetas se.se_meta_list}
 	  else
 	      dfs (pred n)
-      with e when Errors.noncritical e ->
+      with e when CErrors.noncritical e ->
 	begin
 	  enstack_subsubgoals env se stack gls;
 	  dfs n
@@ -817,9 +823,8 @@ let define_tac id args body gls =
 
 let cast_tac id_or_thesis typ gls =
   match id_or_thesis with
-      This id ->
-	let body = pf_get_hyp gls id |> get_value in
-	  Proofview.V82.of_tactic (convert_hyp (of_tuple (id,body,typ))) gls
+    | This id ->
+        Proofview.V82.of_tactic  (id |> pf_get_hyp gls |> NamedDecl.set_id id |> NamedDecl.set_type typ |> convert_hyp) gls
     | Thesis (For _ ) ->
 	error "\"thesis for ...\" is not applicable here."
     | Thesis Plain ->
@@ -1078,12 +1083,12 @@ let thesis_for obj typ per_info env=
   let cind,all_args=decompose_app typ in
   let ind,u = destInd cind in
   let _ = if not (eq_ind ind per_info.per_ind) then
-    errorlabstrm "thesis_for"
+    user_err ~hdr:"thesis_for"
       ((Printer.pr_constr_env env Evd.empty obj) ++ spc () ++
 	 str"cannot give an induction hypothesis (wrong inductive type).") in
   let params,args = List.chop per_info.per_nparams all_args in
   let _ = if not (List.for_all2 eq_constr params per_info.per_params) then
-    errorlabstrm "thesis_for"
+    user_err ~hdr:"thesis_for"
       ((Printer.pr_constr_env env Evd.empty obj) ++ spc () ++
 	 str "cannot give an induction hypothesis (wrong parameters).") in
   let hd2 = (applist ((lift (List.length rc) per_info.per_pred),args@[obj])) in
@@ -1219,6 +1224,9 @@ let hrec_for fix_id per_info gls obj_id =
   let hd2 = applist (mkVar fix_id,args@[obj]) in
     compose_lam rc (Reductionops.whd_beta gls.sigma hd2)
 
+let warn_missing_case =
+  CWarnings.create ~name:"declmode-missing-case" ~category:"declmode"
+    (fun () -> strbrk "missing case")
 
 let rec execute_cases fix_name per_info tacnext args objs nhrec tree gls =
   match tree, objs  with
@@ -1293,8 +1301,8 @@ let rec execute_cases fix_name per_info tacnext args objs nhrec tree gls =
 	       end;
 	       match bro with
 		   None ->
-		     Feedback.msg_warning (str "missing case");
-		     tacnext (mkMeta 1)
+                     warn_missing_case ();
+                     tacnext (mkMeta 1)
 		 | Some (sub_ids,tree) ->
 		     let br_args =
 		       List.filter
diff --git a/plugins/decl_mode/g_decl_mode.ml4 b/plugins/decl_mode/g_decl_mode.ml4
index 78a95143d..18a35c6cf 100644
--- a/plugins/decl_mode/g_decl_mode.ml4
+++ b/plugins/decl_mode/g_decl_mode.ml4
@@ -8,6 +8,8 @@
 
 (*i camlp4deps: "grammar/grammar.cma" i*)
 
+DECLARE PLUGIN "decl_mode_plugin"
+
 open Compat
 open Pp
 open Decl_expr
@@ -17,7 +19,7 @@ open Vernacexpr
 open Tok (* necessary for camlp4 *)
 
 open Pcoq.Constr
-open Pcoq.Tactic
+open Pltac
 open Ppdecl_proof
 
 let pr_goal gs =
@@ -56,7 +58,7 @@ let interp_proof_instr _ { Evd.it = gl ; sigma = sigma }=
 let vernac_decl_proof () = 
   let pf = Proof_global.give_me_the_proof () in
   if Proof.is_done pf then 
-    Errors.error "Nothing left to prove here."
+    CErrors.error "Nothing left to prove here."
   else
     begin
       Decl_proof_instr.go_to_proof_mode () ;
@@ -98,7 +100,7 @@ let _ = Pptactic.declare_extra_genarg_pprule wit_proof_instr
 
 let classify_proof_instr = function
   | { instr = Pescape |Pend B_proof } -> VtProofMode "Classic", VtNow
-  | _ -> VtProofStep false, VtLater
+  | _ -> Vernac_classifier.classify_as_proofstep
 
 (* We use the VERNAC EXTEND facility with a custom non-terminal
     to populate [proof_mode] with a new toplevel interpreter.
diff --git a/plugins/decl_mode/ppdecl_proof.ml b/plugins/decl_mode/ppdecl_proof.ml
index 4c71f0410..59a0bb5a2 100644
--- a/plugins/decl_mode/ppdecl_proof.ml
+++ b/plugins/decl_mode/ppdecl_proof.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-open Errors
+open CErrors
 open Pp
 open Decl_expr
 open Names
diff --git a/plugins/derive/derive.ml b/plugins/derive/derive.ml
index 5d1551106..e39d17b52 100644
--- a/plugins/derive/derive.ml
+++ b/plugins/derive/derive.ml
@@ -51,9 +51,9 @@ let start_deriving f suchthat lemma =
           [suchthat], respectively. *)
       let (opaque,f_def,lemma_def) =
         match com with
-        | Admitted _ -> Errors.error"Admitted isn't supported in Derive."
+        | Admitted _ -> CErrors.error"Admitted isn't supported in Derive."
         | Proved (_,Some _,_) ->
-            Errors.error"Cannot save a proof of Derive with an explicit name."
+            CErrors.error"Cannot save a proof of Derive with an explicit name."
         | Proved (opaque, None, obj) ->
             match Proof_global.(obj.entries) with
             | [_;f_def;lemma_def] ->
diff --git a/plugins/derive/derive_plugin.mllib b/plugins/derive/derive_plugin.mlpack
index 5ee0fc6da..5ee0fc6da 100644
--- a/plugins/derive/derive_plugin.mllib
+++ b/plugins/derive/derive_plugin.mlpack
diff --git a/plugins/derive/g_derive.ml4 b/plugins/derive/g_derive.ml4
index 39cad4d03..deadb3b4d 100644
--- a/plugins/derive/g_derive.ml4
+++ b/plugins/derive/g_derive.ml4
@@ -6,10 +6,12 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-open Constrarg
+open Stdarg
 
 (*i camlp4deps: "grammar/grammar.cma"  i*)
 
+DECLARE PLUGIN "derive_plugin"
+
 let classify_derive_command _ = Vernacexpr.(VtStartProof ("Classic",Doesn'tGuaranteeOpacity,[]),VtLater)
 
 VERNAC COMMAND EXTEND Derive CLASSIFIED BY classify_derive_command
diff --git a/plugins/extraction/common.ml b/plugins/extraction/common.ml
index 3c5f6cb72..de97ba97c 100644
--- a/plugins/extraction/common.ml
+++ b/plugins/extraction/common.ml
@@ -145,7 +145,7 @@ type env = Id.t list * Id.Set.t
 (*s Generic renaming issues for local variable names. *)
 
 let rec rename_id id avoid =
-  if Id.Set.mem id avoid then rename_id (lift_subscript id) avoid else id
+  if Id.Set.mem id avoid then rename_id (increment_subscript id) avoid else id
 
 let rec rename_vars avoid = function
   | [] ->
@@ -308,15 +308,16 @@ end
 
 module DupMap = Map.Make(DupOrd)
 
-let add_duplicate, check_duplicate =
+let add_duplicate, get_duplicate =
   let index = ref 0 and dups = ref DupMap.empty in
   register_cleanup (fun () -> index := 0; dups := DupMap.empty);
   let add mp l =
      incr index;
      let ren = "Coq__" ^ string_of_int !index in
      dups := DupMap.add (mp,l) ren !dups
-  and check mp l = DupMap.find (mp, l) !dups
-  in (add,check)
+  and get mp l =
+    try Some (DupMap.find (mp, l) !dups) with Not_found -> None
+  in (add,get)
 
 type reset_kind = AllButExternal | Everything
 
@@ -510,10 +511,11 @@ let pp_duplicate k' prefix mp rls olab =
       (* Here rls=s::rls', we search the label for s inside mp *)
       List.tl rls, get_nth_label_mp (mp_length mp - mp_length prefix) mp
   in
-  try dottify (check_duplicate prefix lbl :: rls')
-  with Not_found ->
-    assert (get_phase () == Pre); (* otherwise it's too late *)
-    add_duplicate prefix lbl; dottify rls
+  match get_duplicate prefix lbl with
+  | Some ren -> dottify (ren :: rls')
+  | None ->
+     assert (get_phase () == Pre); (* otherwise it's too late *)
+     add_duplicate prefix lbl; dottify rls
 
 let fstlev_ks k = function
   | [] -> assert false
diff --git a/plugins/extraction/common.mli b/plugins/extraction/common.mli
index 2f5601964..b8e95afb3 100644
--- a/plugins/extraction/common.mli
+++ b/plugins/extraction/common.mli
@@ -62,7 +62,7 @@ val top_visible_mp : unit -> module_path
 val push_visible : module_path -> module_path list -> unit
 val pop_visible : unit -> unit
 
-val check_duplicate : module_path -> Label.t -> string
+val get_duplicate : module_path -> Label.t -> string option
 
 type reset_kind = AllButExternal | Everything
 
diff --git a/plugins/extraction/extract_env.ml b/plugins/extraction/extract_env.ml
index a03be5743..e019bb3c2 100644
--- a/plugins/extraction/extract_env.ml
+++ b/plugins/extraction/extract_env.ml
@@ -13,7 +13,7 @@ open Names
 open Libnames
 open Globnames
 open Pp
-open Errors
+open CErrors
 open Util
 open Table
 open Extraction
@@ -507,8 +507,7 @@ let print_structure_to_file (fn,si,mo) dry struc =
   in
   (* First, a dry run, for computing objects to rename or duplicate *)
   set_phase Pre;
-  let devnull = formatter true None in
-  pp_with devnull (d.pp_struct struc);
+  ignore (d.pp_struct struc);
   let opened = opened_libraries () in
   (* Print the implementation *)
   let cout = if dry then None else Option.map open_out fn in
@@ -583,8 +582,8 @@ let rec locate_ref = function
 	| None, Some r -> let refs,mps = locate_ref l in r::refs,mps
 	| Some mp, None -> let refs,mps = locate_ref l in refs,mp::mps
 	| Some mp, Some r ->
-	    warning_both_mod_and_cst q mp r;
-	    let refs,mps = locate_ref l in refs,mp::mps
+           warning_ambiguous_name (q,mp,r);
+           let refs,mps = locate_ref l in refs,mp::mps
 
 (*s Recursive extraction in the Coq toplevel. The vernacular command is
     \verb!Recursive Extraction! [qualid1] ... [qualidn]. Also used when
diff --git a/plugins/extraction/extraction.ml b/plugins/extraction/extraction.ml
index e40621965..2b19c2805 100644
--- a/plugins/extraction/extraction.ml
+++ b/plugins/extraction/extraction.ml
@@ -36,7 +36,7 @@ let current_fixpoints = ref ([] : constant list)
 let none = Evd.empty
 
 (* NB: In OCaml, [type_of] and [get_of] might raise
-   [SingletonInductiveBecomeProp]. this exception will be catched
+   [SingletonInductiveBecomeProp]. This exception will be caught
    in late wrappers around the exported functions of this file,
    in order to display the location of the issue. *)
 
@@ -74,7 +74,7 @@ type flag = info * scheme
   Really important function. *)
 
 let rec flag_of_type env t : flag =
-  let t = whd_betadeltaiota env none t in
+  let t = whd_all env none t in
   match kind_of_term t with
     | Prod (x,t,c) -> flag_of_type (push_rel (LocalAssum (x,t)) env) c
     | Sort s when Sorts.is_prop s -> (Logic,TypeScheme)
@@ -102,14 +102,14 @@ let is_info_scheme env t = match flag_of_type env t with
 (*s [type_sign] gernerates a signature aimed at treating a type application. *)
 
 let rec type_sign env c =
-  match kind_of_term (whd_betadeltaiota env none c) with
+  match kind_of_term (whd_all env none c) with
     | Prod (n,t,d) ->
 	(if is_info_scheme env t then Keep else Kill Kprop)
 	:: (type_sign (push_rel_assum (n,t) env) d)
     | _ -> []
 
 let rec type_scheme_nb_args env c =
-  match kind_of_term (whd_betadeltaiota env none c) with
+  match kind_of_term (whd_all env none c) with
     | Prod (n,t,d) ->
 	let n = type_scheme_nb_args (push_rel_assum (n,t) env) d in
 	if is_info_scheme env t then n+1 else n
@@ -135,7 +135,7 @@ let make_typvar n vl =
   next_ident_away id' vl
 
 let rec type_sign_vl env c =
-  match kind_of_term (whd_betadeltaiota env none c) with
+  match kind_of_term (whd_all env none c) with
     | Prod (n,t,d) ->
 	let s,vl = type_sign_vl (push_rel_assum (n,t) env) d in
 	if not (is_info_scheme env t) then Kill Kprop::s, vl
@@ -143,7 +143,7 @@ let rec type_sign_vl env c =
     | _ -> [],[]
 
 let rec nb_default_params env c =
-  match kind_of_term (whd_betadeltaiota env none c) with
+  match kind_of_term (whd_all env none c) with
     | Prod (n,t,d) ->
 	let n = nb_default_params (push_rel_assum (n,t) env) d in
 	if is_default env t then n+1 else n
@@ -258,7 +258,7 @@ let rec extract_type env db j c args =
     | Const (kn,u as c) ->
 	let r = ConstRef kn in
 	let cb = lookup_constant kn env in
-	let typ,_ = Typeops.type_of_constant env c in
+        let typ = Typeops.type_of_constant_in env c in
 	(match flag_of_type env typ with
 	   | (Logic,_) -> assert false (* Cf. logical cases above *)
 	   | (Info, TypeScheme) ->
@@ -371,8 +371,7 @@ and extract_really_ind env kn mib =
     let packets =
       Array.mapi
 	(fun i mip ->
-	   let (ind,u), ctx = 
-	     Universes.fresh_inductive_instance env (kn,i) in
+	   let (_,u),_ = Universes.fresh_inductive_instance env (kn,i) in
 	   let ar = Inductive.type_of_inductive env ((mib,mip),u) in
 	   let info = (fst (flag_of_type env ar) = Info) in
 	   let s,v = if info then type_sign_vl env ar else [],[] in
@@ -489,7 +488,7 @@ and extract_really_ind env kn mib =
 *)
 
 and extract_type_cons env db dbmap c i =
-  match kind_of_term (whd_betadeltaiota env none c) with
+  match kind_of_term (whd_all env none c) with
     | Prod (n,t,d) ->
 	let env' = push_rel_assum (n,t) env in
 	let db' = (try Int.Map.find i dbmap with Not_found -> 0) :: db in
@@ -591,10 +590,10 @@ let rec extract_term env mle mlt c args =
 	with NotDefault d ->
 	  let mle' = Mlenv.push_std_type mle (Tdummy d) in
 	  ast_pop (extract_term env' mle' mlt c2 args'))
-    | Const (kn,u) ->
-	extract_cst_app env mle mlt kn u args
-    | Construct (cp,u) ->
-	extract_cons_app env mle mlt cp u args
+    | Const (kn,_) ->
+	extract_cst_app env mle mlt kn args
+    | Construct (cp,_) ->
+	extract_cons_app env mle mlt cp args
     | Proj (p, c) ->
         let term = Retyping.expand_projection env (Evd.from_env env) p c [] in
 	  extract_term env mle mlt term args
@@ -645,7 +644,7 @@ and make_mlargs env e s args typs =
 
 (*s Extraction of a constant applied to arguments. *)
 
-and extract_cst_app env mle mlt kn u args =
+and extract_cst_app env mle mlt kn args =
   (* First, the [ml_schema] of the constant, in expanded version. *)
   let nb,t = record_constant_type env kn None in
   let schema = nb, expand env t in
@@ -684,7 +683,7 @@ and extract_cst_app env mle mlt kn u args =
 	let l,l' = List.chop (projection_arity (ConstRef kn)) mla in
 	if not (List.is_empty l') then (List.map (fun _ -> MLexn "Proj Args") l) @ l'
 	else mla
-      with e when Errors.noncritical e -> mla
+      with e when CErrors.noncritical e -> mla
   in
   (* For strict languages, purely logical signatures lead to a dummy lam
      (except when [Kill Ktype] everywhere). So a [MLdummy] is left
@@ -718,7 +717,7 @@ and extract_cst_app env mle mlt kn u args =
    they are fixed, and thus are not used for the computation.
    \end{itemize} *)
 
-and extract_cons_app env mle mlt (((kn,i) as ip,j) as cp) u args =
+and extract_cons_app env mle mlt (((kn,i) as ip,j) as cp) args =
   (* First, we build the type of the constructor, stored in small pieces. *)
   let mi = extract_ind env kn in
   let params_nb = mi.ind_nparams in
diff --git a/plugins/extraction/extraction_plugin.mllib b/plugins/extraction/extraction_plugin.mlpack
index ad3212434..9184f6501 100644
--- a/plugins/extraction/extraction_plugin.mllib
+++ b/plugins/extraction/extraction_plugin.mlpack
@@ -9,4 +9,3 @@ Scheme
 Json
 Extract_env
 G_extraction
-Extraction_plugin_mod
diff --git a/plugins/extraction/g_extraction.ml4 b/plugins/extraction/g_extraction.ml4
index 0a8cb0ccd..e1d6bb4a8 100644
--- a/plugins/extraction/g_extraction.ml4
+++ b/plugins/extraction/g_extraction.ml4
@@ -8,11 +8,12 @@
 
 (*i camlp4deps: "grammar/grammar.cma" i*)
 
+DECLARE PLUGIN "extraction_plugin"
+
 (* ML names *)
 
 open Genarg
 open Stdarg
-open Constrarg
 open Pcoq.Prim
 open Pp
 open Names
diff --git a/plugins/extraction/haskell.ml b/plugins/extraction/haskell.ml
index 764223621..0692c88cd 100644
--- a/plugins/extraction/haskell.ml
+++ b/plugins/extraction/haskell.ml
@@ -9,7 +9,7 @@
 (*s Production of Haskell syntax. *)
 
 open Pp
-open Errors
+open CErrors
 open Util
 open Names
 open Nameops
diff --git a/plugins/extraction/json.ml b/plugins/extraction/json.ml
index 8874afef3..e43c47d05 100644
--- a/plugins/extraction/json.ml
+++ b/plugins/extraction/json.ml
@@ -142,7 +142,8 @@ let rec json_expr env = function
           ("what", json_str "fix:item");
           ("name", json_id fi);
           ("body", json_function env' ti)
-        ]) (Array.map2 (fun a b -> a,b) ids' defs)))
+        ]) (Array.map2 (fun a b -> a,b) ids' defs)));
+      ("for", json_int i);
     ]
   | MLexn s -> json_dict [
       ("what", json_str "expr:exception");
diff --git a/plugins/extraction/modutil.ml b/plugins/extraction/modutil.ml
index bd4831130..60fe8e762 100644
--- a/plugins/extraction/modutil.ml
+++ b/plugins/extraction/modutil.ml
@@ -8,7 +8,7 @@
 
 open Names
 open Globnames
-open Errors
+open CErrors
 open Util
 open Miniml
 open Table
@@ -310,7 +310,7 @@ let base_r = function
 let reset_needed, add_needed, add_needed_mp, found_needed, is_needed =
   let needed = ref Refset'.empty
   and needed_mps = ref MPset.empty in
-  ((fun l -> needed := Refset'.empty; needed_mps := MPset.empty),
+  ((fun () -> needed := Refset'.empty; needed_mps := MPset.empty),
    (fun r -> needed := Refset'.add (base_r r) !needed),
    (fun mp -> needed_mps := MPset.add mp !needed_mps),
    (fun r -> needed := Refset'.remove (base_r r) !needed),
diff --git a/plugins/extraction/ocaml.ml b/plugins/extraction/ocaml.ml
index 3cb3810cb..d89bf95ee 100644
--- a/plugins/extraction/ocaml.ml
+++ b/plugins/extraction/ocaml.ml
@@ -9,7 +9,7 @@
 (*s Production of Ocaml syntax. *)
 
 open Pp
-open Errors
+open CErrors
 open Util
 open Names
 open Nameops
@@ -203,7 +203,7 @@ let rec pp_expr par env args =
 	   let args = List.skipn (projection_arity r) args in
 	   let record = List.hd args in
 	   pp_apply (record ++ str "." ++ pp_global Term r) par (List.tl args)
-	 with e when Errors.noncritical e -> apply (pp_global Term r))
+	 with e when CErrors.noncritical e -> apply (pp_global Term r))
     | MLfix (i,ids,defs) ->
 	let ids',env' = push_vars (List.rev (Array.to_list ids)) env in
 	pp_fix par env' i (Array.of_list (List.rev ids'),defs) args
@@ -555,24 +555,6 @@ let pp_decl = function
     | Dfix (rv,defs,typs) ->
 	pp_Dfix (rv,defs,typs)
 
-let pp_alias_decl ren = function
-  | Dind (kn,i) -> pp_mind kn { i with ind_equiv = RenEquiv ren }
-  | Dtype (r, l, _) ->
-      let name = pp_global Type r in
-      let l = rename_tvars keywords l in
-      let ids = pp_parameters l in
-      hov 2 (str "type " ++ ids ++ name ++ str " =" ++ spc () ++ ids ++
-	     str (ren^".") ++ name)
-  | Dterm (r, a, t) ->
-      let name = pp_global Term r in
-      hov 2 (str "let " ++ name ++ str (" = "^ren^".") ++ name)
-  | Dfix (rv, _, _) ->
-      prvecti (fun i r -> if is_inline_custom r then mt () else
-		 let name = pp_global Term r in
-		 hov 2 (str "let " ++ name ++ str (" = "^ren^".") ++ name) ++
-		 fnl ())
-	rv
-
 let pp_spec = function
   | Sval (r,_) when is_inline_custom r -> mt ()
   | Stype (r,_,_) when is_inline_custom r -> mt ()
@@ -597,42 +579,32 @@ let pp_spec = function
       in
       hov 2 (str "type " ++ ids ++ name ++ def)
 
-let pp_alias_spec ren = function
-  | Sind (kn,i) -> pp_mind kn { i with ind_equiv = RenEquiv ren }
-  | Stype (r,l,_) ->
-      let name = pp_global Type r in
-      let l = rename_tvars keywords l in
-      let ids = pp_parameters l in
-      hov 2 (str "type " ++ ids ++ name ++ str " =" ++ spc () ++ ids ++
-	     str (ren^".") ++ name)
-  | Sval _ -> assert false
-
 let rec pp_specif = function
   | (_,Spec (Sval _ as s)) -> pp_spec s
   | (l,Spec s) ->
-      (try
-	 let ren = Common.check_duplicate (top_visible_mp ()) l in
+     (match Common.get_duplicate (top_visible_mp ()) l with
+      | None -> pp_spec s
+      | Some ren ->
 	 hov 1 (str ("module "^ren^" : sig") ++ fnl () ++ pp_spec s) ++
 	 fnl () ++ str "end" ++ fnl () ++
-	 pp_alias_spec ren s
-       with Not_found -> pp_spec s)
+         str ("include module type of struct include "^ren^" end"))
   | (l,Smodule mt) ->
       let def = pp_module_type [] mt in
-      let def' = pp_module_type [] mt in
       let name = pp_modname (MPdot (top_visible_mp (), l)) in
       hov 1 (str "module " ++ name ++ str " :" ++ fnl () ++ def) ++
-      (try
-	 let ren = Common.check_duplicate (top_visible_mp ()) l in
-	 fnl () ++ hov 1 (str ("module "^ren^" :") ++ fnl () ++ def')
-       with Not_found -> Pp.mt ())
+      (match Common.get_duplicate (top_visible_mp ()) l with
+       | None -> Pp.mt ()
+       | Some ren ->
+         fnl () ++
+         hov 1 (str ("module "^ren^" :") ++ spc () ++
+                str "module type of struct include " ++ name ++ str " end"))
   | (l,Smodtype mt) ->
       let def = pp_module_type [] mt in
       let name = pp_modname (MPdot (top_visible_mp (), l)) in
       hov 1 (str "module type " ++ name ++ str " =" ++ fnl () ++ def) ++
-      (try
-	 let ren = Common.check_duplicate (top_visible_mp ()) l in
-	 fnl () ++ str ("module type "^ren^" = ") ++ name
-       with Not_found -> Pp.mt ())
+      (match Common.get_duplicate (top_visible_mp ()) l with
+       | None -> Pp.mt ()
+       | Some ren -> fnl () ++ str ("module type "^ren^" = ") ++ name)
 
 and pp_module_type params = function
   | MTident kn ->
@@ -653,8 +625,10 @@ and pp_module_type params = function
       let l = List.rev l in
       pop_visible ();
       str "sig" ++ fnl () ++
-      v 1 (str " " ++ prlist_with_sep cut2 identity l) ++
-	fnl () ++ str "end"
+      (if List.is_empty l then mt ()
+       else
+         v 1 (str " " ++ prlist_with_sep cut2 identity l) ++ fnl ())
+      ++ str "end"
   | MTwith(mt,ML_With_type(idl,vl,typ)) ->
       let ids = pp_parameters (rename_tvars keywords vl) in
       let mp_mt = msid_of_mt mt in
@@ -681,12 +655,11 @@ let is_short = function MEident _ | MEapply _ -> true | _ -> false
 
 let rec pp_structure_elem = function
   | (l,SEdecl d) ->
-       (try
-	 let ren = Common.check_duplicate (top_visible_mp ()) l in
+     (match Common.get_duplicate (top_visible_mp ()) l with
+      | None -> pp_decl d
+      | Some ren ->
 	 hov 1 (str ("module "^ren^" = struct") ++ fnl () ++ pp_decl d) ++
-	 fnl () ++ str "end" ++ fnl () ++
-	 pp_alias_decl ren d
-	with Not_found -> pp_decl d)
+	 fnl () ++ str "end" ++ fnl () ++ str ("include "^ren))
   | (l,SEmodule m) ->
       let typ =
         (* virtual printing of the type, in order to have a correct mli later*)
@@ -699,18 +672,16 @@ let rec pp_structure_elem = function
       hov 1
 	(str "module " ++ name ++ typ ++ str " =" ++
 	 (if is_short m.ml_mod_expr then spc () else fnl ()) ++ def) ++
-      (try
-	 let ren = Common.check_duplicate (top_visible_mp ()) l in
-	 fnl () ++ str ("module "^ren^" = ") ++ name
-       with Not_found -> mt ())
+      (match Common.get_duplicate (top_visible_mp ()) l with
+       | Some ren -> fnl () ++ str ("module "^ren^" = ") ++ name
+       | None -> mt ())
   | (l,SEmodtype m) ->
       let def = pp_module_type [] m in
       let name = pp_modname (MPdot (top_visible_mp (), l)) in
       hov 1 (str "module type " ++ name ++ str " =" ++ fnl () ++ def) ++
-      (try
-	 let ren = Common.check_duplicate (top_visible_mp ()) l in
-         fnl () ++ str ("module type "^ren^" = ") ++ name
-       with Not_found -> mt ())
+      (match Common.get_duplicate (top_visible_mp ()) l with
+       | None -> mt ()
+       | Some ren -> fnl () ++ str ("module type "^ren^" = ") ++ name)
 
 and pp_module_expr params = function
   | MEident mp -> pp_modname mp
@@ -732,8 +703,10 @@ and pp_module_expr params = function
       let l = List.rev l in
       pop_visible ();
       str "struct" ++ fnl () ++
-      v 1 (str " " ++ prlist_with_sep cut2 identity l) ++
-      fnl () ++ str "end"
+      (if List.is_empty l then mt ()
+       else
+         v 1 (str " " ++ prlist_with_sep cut2 identity l) ++ fnl ())
+      ++ str "end"
 
 let rec prlist_sep_nonempty sep f = function
   | [] -> mt ()
diff --git a/plugins/extraction/scheme.ml b/plugins/extraction/scheme.ml
index 7b0f14dff..a6309e61f 100644
--- a/plugins/extraction/scheme.ml
+++ b/plugins/extraction/scheme.ml
@@ -9,7 +9,7 @@
 (*s Production of Scheme syntax. *)
 
 open Pp
-open Errors
+open CErrors
 open Util
 open Names
 open Miniml
diff --git a/plugins/extraction/table.ml b/plugins/extraction/table.ml
index 560fe5aea..5e7d810c9 100644
--- a/plugins/extraction/table.ml
+++ b/plugins/extraction/table.ml
@@ -15,7 +15,7 @@ open Libobject
 open Goptions
 open Libnames
 open Globnames
-open Errors
+open CErrors
 open Util
 open Pp
 open Miniml
@@ -293,83 +293,96 @@ let pr_long_global ref = pr_path (Nametab.path_of_global ref)
 
 (*S Warning and Error messages. *)
 
-let err s = errorlabstrm "Extraction" s
+let err s = user_err ~hdr:"Extraction" s
+
+let warn_extraction_axiom_to_realize =
+  CWarnings.create ~name:"extraction-axiom-to-realize" ~category:"extraction"
+         (fun axioms ->
+          let s = if Int.equal (List.length axioms) 1 then "axiom" else "axioms" in
+          strbrk ("The following "^s^" must be realized in the extracted code:")
+                   ++ hov 1 (spc () ++ prlist_with_sep spc safe_pr_global axioms)
+                   ++ str "." ++ fnl ())
+
+let warn_extraction_logical_axiom =
+  CWarnings.create ~name:"extraction-logical-axiom" ~category:"extraction"
+         (fun axioms ->
+          let s =
+            if Int.equal (List.length axioms) 1 then "axiom was" else "axioms were"
+          in
+          (strbrk ("The following logical "^s^" encountered:") ++
+             hov 1 (spc () ++ prlist_with_sep spc safe_pr_global axioms ++ str ".\n")
+           ++ strbrk "Having invalid logical axiom in the environment when extracting"
+           ++ spc () ++ strbrk "may lead to incorrect or non-terminating ML terms." ++
+             fnl ()))
 
 let warning_axioms () =
   let info_axioms = Refset'.elements !info_axioms in
-  if List.is_empty info_axioms then ()
-  else begin
-    let s = if Int.equal (List.length info_axioms) 1 then "axiom" else "axioms" in
-    Feedback.msg_warning
-      (str ("The following "^s^" must be realized in the extracted code:")
-       ++ hov 1 (spc () ++ prlist_with_sep spc safe_pr_global info_axioms)
-       ++ str "." ++ fnl ())
-  end;
+  if not (List.is_empty info_axioms) then
+    warn_extraction_axiom_to_realize info_axioms;
   let log_axioms = Refset'.elements !log_axioms in
-  if List.is_empty log_axioms then ()
-  else begin
-    let s = if Int.equal (List.length log_axioms) 1 then "axiom was" else "axioms were"
-    in
-    Feedback.msg_warning
-      (str ("The following logical "^s^" encountered:") ++
-       hov 1
-         (spc () ++ prlist_with_sep spc safe_pr_global log_axioms ++ str ".\n")
-       ++
-       str "Having invalid logical axiom in the environment when extracting" ++
-       spc () ++ str "may lead to incorrect or non-terminating ML terms." ++
-       fnl ())
-  end
+  if not (List.is_empty log_axioms) then
+    warn_extraction_logical_axiom log_axioms
+
+let warn_extraction_opaque_accessed =
+  CWarnings.create ~name:"extraction-opaque-accessed" ~category:"extraction"
+    (fun lst -> strbrk "The extraction is currently set to bypass opacity, " ++
+                  strbrk "the following opaque constant bodies have been accessed :" ++
+                  lst ++ str "." ++ fnl ())
+
+let warn_extraction_opaque_as_axiom =
+  CWarnings.create ~name:"extraction-opaque-as-axiom" ~category:"extraction"
+    (fun lst -> strbrk "The extraction now honors the opacity constraints by default, " ++
+	 strbrk "the following opaque constants have been extracted as axioms :" ++
+	 lst ++ str "." ++ fnl () ++
+	 strbrk "If necessary, use \"Set Extraction AccessOpaque\" to change this."
+	 ++ fnl ())
 
 let warning_opaques accessed =
   let opaques = Refset'.elements !opaques in
-  if List.is_empty opaques then ()
-  else
+  if not (List.is_empty opaques) then
     let lst = hov 1 (spc () ++ prlist_with_sep spc safe_pr_global opaques) in
-    if accessed then
-      Feedback.msg_warning
-	(str "The extraction is currently set to bypass opacity,\n" ++
-	 str "the following opaque constant bodies have been accessed :" ++
-	 lst ++ str "." ++ fnl ())
-    else
-      Feedback.msg_warning
-	(str "The extraction now honors the opacity constraints by default,\n" ++
-	 str "the following opaque constants have been extracted as axioms :" ++
-	 lst ++ str "." ++ fnl () ++
-	 str "If necessary, use \"Set Extraction AccessOpaque\" to change this."
-	 ++ fnl ())
-
-let warning_both_mod_and_cst q mp r =
- Feedback.msg_warning
-   (str "The name " ++ pr_qualid q ++ str " is ambiguous, " ++
-    str "do you mean module " ++
-    pr_long_mp mp ++
-    str " or object " ++
-    pr_long_global r ++ str " ?" ++ fnl () ++
-    str "First choice is assumed, for the second one please use " ++
-    str "fully qualified name." ++ fnl ())
+    if accessed then warn_extraction_opaque_accessed lst
+    else warn_extraction_opaque_as_axiom lst
+
+let warning_ambiguous_name =
+  CWarnings.create ~name:"extraction-ambiguous-name" ~category:"extraction"
+    (fun (q,mp,r) -> strbrk "The name " ++ pr_qualid q ++ strbrk " is ambiguous, " ++
+                       strbrk "do you mean module " ++
+                       pr_long_mp mp ++
+                       strbrk " or object " ++
+                       pr_long_global r ++ str " ?" ++ fnl () ++
+                       strbrk "First choice is assumed, for the second one please use " ++
+                       strbrk "fully qualified name." ++ fnl ())
 
 let error_axiom_scheme r i =
   err (str "The type scheme axiom " ++ spc () ++
        safe_pr_global r ++ spc () ++ str "needs " ++ int i ++
        str " type variable(s).")
 
+let warn_extraction_inside_module =
+  CWarnings.create ~name:"extraction-inside-module" ~category:"extraction"
+      (fun () -> strbrk "Extraction inside an opened module is experimental." ++
+       strbrk "In case of problem, close it first.")
+
+
 let check_inside_module () =
   if Lib.is_modtype () then
     err (str "You can't do that within a Module Type." ++ fnl () ++
 	 str "Close it and try again.")
   else if Lib.is_module () then
-    Feedback.msg_warning
-      (str "Extraction inside an opened module is experimental.\n" ++
-       str "In case of problem, close it first.\n")
+    warn_extraction_inside_module ()
 
 let check_inside_section () =
   if Lib.sections_are_opened () then
     err (str "You can't do that within a section." ++ fnl () ++
 	 str "Close it and try again.")
 
-let warning_id s =
-  Feedback.msg_warning (str ("The identifier "^s^
-		    " contains __ which is reserved for the extraction"))
+let warn_extraction_reserved_identifier =
+  CWarnings.create ~name:"extraction-reserved-identifier" ~category:"extraction"
+    (fun s -> strbrk ("The identifier "^s^
+                " contains __ which is reserved for the extraction"))
+
+let warning_id s = warn_extraction_reserved_identifier s
 
 let error_constant r =
   err (safe_pr_global r ++ str " is not a constant.")
@@ -428,7 +441,7 @@ let error_MPfile_as_mod mp b =
 let argnames_of_global r =
   let typ = Global.type_of_global_unsafe r in
   let rels,_ =
-    decompose_prod (Reduction.whd_betadeltaiota (Global.env ()) typ) in
+    decompose_prod (Reduction.whd_all (Global.env ()) typ) in
   List.rev_map fst rels
 
 let msg_of_implicit = function
@@ -447,12 +460,15 @@ let error_remaining_implicit k =
        str "You might also try Unset Extraction SafeImplicits to force" ++
        fnl() ++ str "the extraction of unsafe code and review it manually.")
 
+let warn_extraction_remaining_implicit =
+  CWarnings.create ~name:"extraction-remaining-implicit" ~category:"extraction"
+    (fun s -> strbrk ("At least an implicit occurs after extraction : "^s^".") ++ fnl () ++
+     strbrk "Extraction SafeImplicits is unset, extracting nonetheless,"
+     ++ strbrk "but this code is potentially unsafe, please review it manually.")
+
 let warning_remaining_implicit k =
   let s = msg_of_implicit k in
-  Feedback.msg_warning
-    (str ("At least an implicit occurs after extraction : "^s^".") ++ fnl () ++
-     str "Extraction SafeImplicits is unset, extracting nonetheless," ++ fnl ()
-     ++ str "but this code is potentially unsafe, please review it manually.")
+  warn_extraction_remaining_implicit s
 
 let check_loaded_modfile mp = match base_mp mp with
   | MPfile dp ->
@@ -864,7 +880,7 @@ let extract_constant_inline inline r ids s =
     | ConstRef kn ->
 	let env = Global.env () in
 	let typ = Global.type_of_global_unsafe (ConstRef kn) in
-	let typ = Reduction.whd_betadeltaiota env typ in
+	let typ = Reduction.whd_all env typ in
 	if Reduction.is_arity env typ
 	  then begin
 	    let nargs = Hook.get use_type_scheme_nb_args env typ in
diff --git a/plugins/extraction/table.mli b/plugins/extraction/table.mli
index 62c20bd3a..15a08756c 100644
--- a/plugins/extraction/table.mli
+++ b/plugins/extraction/table.mli
@@ -21,8 +21,7 @@ val safe_basename_of_global : global_reference -> Id.t
 
 val warning_axioms : unit -> unit
 val warning_opaques : bool -> unit
-val warning_both_mod_and_cst :
- qualid -> module_path -> global_reference -> unit
+val warning_ambiguous_name : ?loc:Loc.t -> qualid * module_path * global_reference -> unit
 val warning_id : string -> unit
 val error_axiom_scheme : global_reference -> int -> 'a
 val error_constant : global_reference -> 'a
diff --git a/plugins/firstorder/formula.ml b/plugins/firstorder/formula.ml
index 2ed436c6b..b34a36492 100644
--- a/plugins/firstorder/formula.ml
+++ b/plugins/firstorder/formula.ml
@@ -15,11 +15,12 @@ open Tacmach
 open Util
 open Declarations
 open Globnames
-open Context.Rel.Declaration
+
+module RelDecl = Context.Rel.Declaration
 
 let qflag=ref true
 
-let red_flags=ref Closure.betaiotazeta
+let red_flags=ref CClosure.betaiotazeta
 
 let (=?) f g i1 i2 j1 j2=
   let c=f i1 i2 in
@@ -59,12 +60,12 @@ let ind_hyps nevar ind largs gls=
     Array.map myhyps types
 
 let special_nf gl=
-  let infos=Closure.create_clos_infos !red_flags (pf_env gl) in
-    (fun t -> Closure.norm_val infos (Closure.inject t))
+  let infos=CClosure.create_clos_infos !red_flags (pf_env gl) in
+    (fun t -> CClosure.norm_val infos (CClosure.inject t))
 
 let special_whd gl=
-  let infos=Closure.create_clos_infos !red_flags (pf_env gl) in
-    (fun t -> Closure.whd_val infos (Closure.inject t))
+  let infos=CClosure.create_clos_infos !red_flags (pf_env gl) in
+    (fun t -> CClosure.whd_val infos (CClosure.inject t))
 
 type kind_of_formula=
     Arrow of constr*constr
@@ -141,7 +142,7 @@ let build_atoms gl metagen side cciterm =
 	    end;
 	  let v = ind_hyps 0 i l gl in
 	  let g i _ decl =
-	    build_rec env polarity (lift i (get_type decl)) in
+	    build_rec env polarity (lift i (RelDecl.get_type decl)) in
 	  let f l =
 	    List.fold_left_i g (1-(List.length l)) () l in
 	    if polarity && (* we have a constant constructor *)
@@ -152,7 +153,7 @@ let build_atoms gl metagen side cciterm =
 	  let var=mkMeta (metagen true) in
 	  let v =(ind_hyps 1 i l gl).(0) in
 	  let g i _ decl =
-	    build_rec (var::env) polarity (lift i (get_type decl)) in
+	    build_rec (var::env) polarity (lift i (RelDecl.get_type decl)) in
 	    List.fold_left_i g (2-(List.length l)) () v
       | Forall(_,b)->
 	  let var=mkMeta (metagen true) in
@@ -225,7 +226,7 @@ let build_formula side nam typ gl metagen=
 		  | And(_,_,_)        -> Rand
 		  | Or(_,_,_)         -> Ror
 		  | Exists (i,l) ->
-		      let d = get_type (List.last (ind_hyps 0 i l gl).(0)) in
+		      let d = RelDecl.get_type (List.last (ind_hyps 0 i l gl).(0)) in
 			Rexists(m,d,trivial)
 		  | Forall (_,a) -> Rforall
 		  | Arrow (a,b) -> Rarrow in
diff --git a/plugins/firstorder/formula.mli b/plugins/firstorder/formula.mli
index 0f70d3ea0..5db8ff59a 100644
--- a/plugins/firstorder/formula.mli
+++ b/plugins/firstorder/formula.mli
@@ -11,7 +11,7 @@ open Globnames
 
 val qflag : bool ref
 
-val red_flags: Closure.RedFlags.reds ref
+val red_flags: CClosure.RedFlags.reds ref
 
 val (=?) : ('a -> 'a -> int) -> ('b -> 'b -> int) ->
   'a -> 'a -> 'b -> 'b -> int
diff --git a/plugins/firstorder/g_ground.ml4 b/plugins/firstorder/g_ground.ml4
index a78532e33..260e86ad6 100644
--- a/plugins/firstorder/g_ground.ml4
+++ b/plugins/firstorder/g_ground.ml4
@@ -15,8 +15,8 @@ open Goptions
 open Tacticals
 open Tacinterp
 open Libnames
-open Constrarg
 open Stdarg
+open Tacarg
 open Pcoq.Prim
 
 DECLARE PLUGIN "ground_plugin"
@@ -116,9 +116,14 @@ open Pp
 open Genarg
 open Ppconstr
 open Printer
-let pr_firstorder_using_raw _ _ _ l = str "using " ++ prlist_with_sep pr_comma pr_reference l
-let pr_firstorder_using_glob _ _ _ l = str "using " ++ prlist_with_sep pr_comma (pr_or_var (fun x -> (pr_global (snd x)))) l
-let pr_firstorder_using_typed _ _ _ l = str "using " ++ prlist_with_sep pr_comma pr_global l
+let pr_firstorder_using_raw _ _ _ = Pptactic.pr_auto_using pr_reference
+let pr_firstorder_using_glob _ _ _ = Pptactic.pr_auto_using (pr_or_var (fun x -> pr_global (snd x)))
+let pr_firstorder_using_typed _ _ _ = Pptactic.pr_auto_using pr_global
+
+let warn_deprecated_syntax =
+  CWarnings.create ~name:"firstorder-deprecated-syntax" ~category:"deprecated"
+    (fun () -> Pp.strbrk "Deprecated syntax; use \",\" as separator")
+
 
 ARGUMENT EXTEND firstorder_using
   TYPED AS reference_list
@@ -130,8 +135,7 @@ ARGUMENT EXTEND firstorder_using
 | [ "using" reference(a) ] -> [ [a] ]
 | [ "using" reference(a) "," ne_reference_list_sep(l,",") ] -> [ a::l ]
 | [ "using" reference(a) reference(b) reference_list(l) ] -> [
-    Flags.if_verbose
-      Feedback.msg_warning (Pp.str "Deprecated syntax; use \",\" as separator");
+    warn_deprecated_syntax ();
     a::b::l
   ]
 | [ ] -> [ [] ]
@@ -153,6 +157,8 @@ TACTIC EXTEND gintuition
 END
 
 open Proofview.Notations
+open Cc_plugin
+open Decl_mode_plugin
 
 let default_declarative_automation =
   Proofview.tclUNIT () >>= fun () -> (* delay for [congruence_depth] *)
diff --git a/plugins/firstorder/ground.ml b/plugins/firstorder/ground.ml
index d7da85b4f..628af4e71 100644
--- a/plugins/firstorder/ground.ml
+++ b/plugins/firstorder/ground.ml
@@ -24,8 +24,8 @@ let update_flags ()=
   in
     List.iter f (Classops.coercions ());
     red_flags:=
-    Closure.RedFlags.red_add_transparent
-      Closure.betaiotazeta
+    CClosure.RedFlags.red_add_transparent
+      CClosure.betaiotazeta
       (Names.Id.Pred.full,Names.Cpred.complement !predref)
 
 let ground_tac solver startseq gl=
diff --git a/plugins/firstorder/ground_plugin.mllib b/plugins/firstorder/ground_plugin.mlpack
index 447a1fb51..65fb2e9a1 100644
--- a/plugins/firstorder/ground_plugin.mllib
+++ b/plugins/firstorder/ground_plugin.mlpack
@@ -5,4 +5,3 @@ Rules
 Instances
 Ground
 G_ground
-Ground_plugin_mod
diff --git a/plugins/firstorder/instances.ml b/plugins/firstorder/instances.ml
index 5eff2f277..eebd974ea 100644
--- a/plugins/firstorder/instances.ml
+++ b/plugins/firstorder/instances.ml
@@ -8,7 +8,7 @@
 
 open Unify
 open Rules
-open Errors
+open CErrors
 open Util
 open Term
 open Vars
@@ -107,7 +107,7 @@ let mk_open_instance id idc gl m t=
       let typ=pf_unsafe_type_of gl idc in
 	(* since we know we will get a product,
 	   reduction is not too expensive *)
-      let (nam,_,_)=destProd (whd_betadeltaiota env evmap typ) in
+      let (nam,_,_)=destProd (whd_all env evmap typ) in
 	match nam with
 	    Name id -> id
 	  | Anonymous ->  dummy_bvid in
@@ -156,7 +156,7 @@ let left_instance_tac (inst,id) continue seq=
 		      (mkApp(idc,[|ot|])) rc in
 		  let evmap, _ =
 		    try Typing.type_of (pf_env gl) evmap gt
-		    with e when Errors.noncritical e ->
+		    with e when CErrors.noncritical e ->
 		      error "Untypable instance, maybe higher-order non-prenex quantification" in
 		    tclTHEN (Refiner.tclEVARS evmap) (Proofview.V82.of_tactic (generalize [gt])) gl)
 	    else
diff --git a/plugins/firstorder/rules.ml b/plugins/firstorder/rules.ml
index 92b6e828e..7ffc78928 100644
--- a/plugins/firstorder/rules.ml
+++ b/plugins/firstorder/rules.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-open Errors
+open CErrors
 open Util
 open Names
 open Term
@@ -19,7 +19,8 @@ open Formula
 open Sequent
 open Globnames
 open Locus
-open Context.Named.Declaration
+
+module NamedDecl = Context.Named.Declaration
 
 type seqtac= (Sequent.t -> tactic) -> Sequent.t -> tactic
 
@@ -36,12 +37,12 @@ let wrap n b continue seq gls=
       match nc with
 	  []->anomaly (Pp.str "Not the expected number of hyps")
 	| nd::q->
-            let id = get_id nd in
+            let id = NamedDecl.get_id nd in
 	    if occur_var env id (pf_concl gls) ||
 	      List.exists (occur_var_in_decl env id) ctx then
 		(aux (i-1) q (nd::ctx))
 	    else
-	      add_formula Hyp (VarRef id) (get_type nd) (aux (i-1) q (nd::ctx)) gls in
+	      add_formula Hyp (VarRef id) (NamedDecl.get_type nd) (aux (i-1) q (nd::ctx)) gls in
   let seq1=aux n nc [] in
   let seq2=if b then
     add_formula Concl dummy_id (pf_concl gls) seq1 gls else seq1 in
diff --git a/plugins/firstorder/sequent.ml b/plugins/firstorder/sequent.ml
index 3e8033da0..1248b60a7 100644
--- a/plugins/firstorder/sequent.ml
+++ b/plugins/firstorder/sequent.ml
@@ -7,7 +7,7 @@
 (************************************************************************)
 
 open Term
-open Errors
+open CErrors
 open Util
 open Formula
 open Unify
diff --git a/plugins/fourier/fourierR.ml b/plugins/fourier/fourierR.ml
index dc5dd45ab..8e193c753 100644
--- a/plugins/fourier/fourierR.ml
+++ b/plugins/fourier/fourierR.ml
@@ -462,7 +462,7 @@ let rec fourier () =
   Proofview.Goal.nf_enter { enter = begin fun gl ->
     let concl = Proofview.Goal.concl gl in
     Coqlib.check_required_library ["Coq";"fourier";"Fourier"];
-    let goal = strip_outer_cast concl in
+    let goal = Termops.strip_outer_cast concl in
     let fhyp=Id.of_string "new_hyp_for_fourier" in
     (* si le but est une inéquation, on introduit son contraire,
        et le but à prouver devient False *)
@@ -501,11 +501,11 @@ let rec fourier () =
 		        with NoIneq -> ())
               hyps;
     (* lineq = les inéquations découlant des hypothèses *)
-    if !lineq=[] then Errors.error "No inequalities";
+    if !lineq=[] then CErrors.error "No inequalities";
     let res=fourier_lineq (!lineq) in
     let tac=ref (Proofview.tclUNIT ()) in
     if res=[]
-    then Errors.error "fourier failed"
+    then CErrors.error "fourier failed"
     (* l'algorithme de Fourier a réussi: on va en tirer une preuve Coq *)
     else (match res with
         [(cres,sres,lc)]->
diff --git a/plugins/fourier/fourier_plugin.mllib b/plugins/fourier/fourier_plugin.mlpack
index 0383b1a80..b6262f8ae 100644
--- a/plugins/fourier/fourier_plugin.mllib
+++ b/plugins/fourier/fourier_plugin.mlpack
@@ -1,4 +1,3 @@
 Fourier
 FourierR
 G_fourier
-Fourier_plugin_mod
diff --git a/plugins/funind/functional_principles_proofs.ml b/plugins/funind/functional_principles_proofs.ml
index 52094cf08..527f4f0b1 100644
--- a/plugins/funind/functional_principles_proofs.ml
+++ b/plugins/funind/functional_principles_proofs.ml
@@ -1,5 +1,5 @@
 open Printer
-open Errors
+open CErrors
 open Util
 open Term
 open Vars
@@ -16,6 +16,8 @@ open Libnames
 open Globnames
 open Context.Rel.Declaration
 
+module RelDecl = Context.Rel.Declaration
+
 (* let msgnl = Pp.msgnl *)
 
 (*
@@ -27,7 +29,7 @@ let observe strm =
 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 e = Cerrors.process_vernac_interp_error e in
+   let e = ExplainErr.process_vernac_interp_error e in
    let goal = begin try (Printer.pr_goal g) with _ -> assert false end in
    msg_debug (str "observation "++ s++str " raised exception " ++
 	    Errors.print e ++ str " on goal " ++ goal );
@@ -52,7 +54,7 @@ let rec print_debug_queue e =
       let _ =
 	match e with
 	| Some e ->
-	   Feedback.msg_debug (hov 0 (lmsg ++ (str " raised exception " ++ Errors.print e) ++ str " on goal" ++ fnl() ++ goal))
+	   Feedback.msg_debug (hov 0 (lmsg ++ (str " raised exception " ++ CErrors.print e) ++ str " on goal" ++ fnl() ++ goal))
 	| None ->
 	   begin
 	     Feedback.msg_debug (str " from " ++ lmsg ++ str " on goal" ++ fnl() ++ goal);
@@ -74,9 +76,9 @@ let do_observe_tac s tac g =
     ignore(Stack.pop debug_queue);
     v
   with reraise ->
-    let reraise = Errors.push reraise in
+    let reraise = CErrors.push reraise in
     if not (Stack.is_empty debug_queue)
-    then print_debug_queue (Some (fst (Cerrors.process_vernac_interp_error reraise)));
+    then print_debug_queue (Some (fst (ExplainErr.process_vernac_interp_error reraise)));
     iraise reraise
 
 let observe_tac_stream s tac g =
@@ -141,7 +143,7 @@ let is_trivial_eq t =
 	    eq_constr t1 t2 && eq_constr a1 a2
 	| _ -> false
     end
-  with e when Errors.noncritical e -> false
+  with e when CErrors.noncritical e -> false
   in
 (*   observe (str "is_trivial_eq " ++ Printer.pr_lconstr t ++ (if res then str " true" else str " false")); *)
   res
@@ -167,7 +169,7 @@ let is_incompatible_eq t =
 	    (eq_constr u1 u2 &&
 	       incompatible_constructor_terms t1 t2)
 	| _ -> false
-    with e when Errors.noncritical e -> false
+    with e when CErrors.noncritical e -> false
   in
   if res then   observe (str "is_incompatible_eq " ++ Printer.pr_lconstr t);
   res
@@ -223,8 +225,8 @@ let isAppConstruct ?(env=Global.env ()) t =
 
 let nf_betaiotazeta = (* Reductionops.local_strong Reductionops.whd_betaiotazeta  *)
   let clos_norm_flags flgs env sigma t =
-    Closure.norm_val (Closure.create_clos_infos flgs env) (Closure.inject (Reductionops.nf_evar sigma t)) in
-  clos_norm_flags Closure.betaiotazeta  Environ.empty_env Evd.empty
+    CClosure.norm_val (CClosure.create_clos_infos flgs env) (CClosure.inject (Reductionops.nf_evar sigma t)) in
+  clos_norm_flags CClosure.betaiotazeta  Environ.empty_env Evd.empty
 
 
 
@@ -254,7 +256,7 @@ let change_eq env sigma hyp_id (context:Context.Rel.t) x t end_of_type  =
 	  then
 	    (jmeq_refl (),(args.(1),args.(0)),(args.(3),args.(2)),args.(0))
 	  else nochange "not an equality"
-      with e when Errors.noncritical e -> nochange "not an equality"
+      with e when CErrors.noncritical e -> nochange "not an equality"
     in
     if not ((closed0 (fst t1)) && (closed0 (snd t1)))then nochange "not a closed lhs";
     let rec compute_substitution sub t1 t2 =
@@ -281,7 +283,7 @@ let change_eq env sigma hyp_id (context:Context.Rel.t) x t end_of_type  =
 	  List.fold_left2 compute_substitution sub args1 args2
 	end
       else
-	if (eq_constr t1 t2) then sub else nochange ~t':(make_refl_eq constructor (Reduction.whd_betadeltaiota env t1) t2)  "cannot solve (diff)"
+	if (eq_constr t1 t2) then sub else nochange ~t':(make_refl_eq constructor (Reduction.whd_all env t1) t2)  "cannot solve (diff)"
     in
     let sub = compute_substitution Int.Map.empty (snd t1) (snd t2) in
     let sub = compute_substitution sub (fst t1) (fst t2) in
@@ -307,7 +309,7 @@ let change_eq env sigma hyp_id (context:Context.Rel.t) x t end_of_type  =
 	   try
 	     let witness = Int.Map.find i sub in
 	     if is_local_def decl then anomaly (Pp.str "can not redefine a rel!");
-	     (Termops.pop end_of_type,ctxt_size,mkLetIn (get_name decl, witness, get_type decl, witness_fun))
+	     (Termops.pop end_of_type,ctxt_size,mkLetIn (RelDecl.get_name decl, witness, RelDecl.get_type decl, witness_fun))
 	   with Not_found  ->
 	     (mkProd_or_LetIn decl end_of_type, ctxt_size + 1, mkLambda_or_LetIn decl witness_fun)
 	)
@@ -625,8 +627,8 @@ let treat_new_case ptes_infos nb_prod continue_tac term dyn_infos =
 let my_orelse tac1 tac2 g =
   try
     tac1 g
-  with e when Errors.noncritical e ->
-(*     observe (str "using snd tac since : " ++ Errors.print e); *)
+  with e when CErrors.noncritical e ->
+(*     observe (str "using snd tac since : " ++ CErrors.print e); *)
     tac2 g
 
 let instanciate_hyps_with_args (do_prove:Id.t list -> tactic) hyps args_id =
@@ -938,8 +940,8 @@ let generalize_non_dep hyp g =
     ((* observe_tac "thin" *) (thin to_revert))
     g
 
-let id_of_decl decl = Nameops.out_name (get_name decl)
-let var_of_decl decl = mkVar (id_of_decl decl)
+let id_of_decl = RelDecl.get_name %> Nameops.out_name
+let var_of_decl = id_of_decl %> mkVar
 let revert idl =
   tclTHEN
     (Proofview.V82.of_tactic (generalize (List.map mkVar idl)))
@@ -1025,7 +1027,7 @@ let do_replace (evd:Evd.evar_map ref) params rec_arg_num rev_args_id f fun_num a
 		{finfos with
 		   equation_lemma = Some (match Nametab.locate (qualid_of_ident equation_lemma_id) with
 					      ConstRef c -> c
-					    | _ -> Errors.anomaly (Pp.str "Not a constant")
+					    | _ -> CErrors.anomaly (Pp.str "Not a constant")
 					 )
 		}
 	  | _ -> ()
@@ -1072,7 +1074,7 @@ let prove_princ_for_struct (evd:Evd.evar_map ref) interactive_proof fun_num fnam
 	 (Name new_id)
       )
     in
-    let fresh_decl = map_name fresh_id in
+    let fresh_decl = RelDecl.map_name fresh_id in
     let princ_info : elim_scheme =
       { princ_info with
 	  params = List.map fresh_decl princ_info.params;
@@ -1085,7 +1087,7 @@ let prove_princ_for_struct (evd:Evd.evar_map ref) interactive_proof fun_num fnam
       match Global.body_of_constant const with
 	| Some body ->
 	     Tacred.cbv_norm_flags
-	       (Closure.RedFlags.mkflags [Closure.RedFlags.fZETA])
+	       (CClosure.RedFlags.mkflags [CClosure.RedFlags.fZETA])
 	       (Global.env ())
 	       (Evd.empty)
 	       body
@@ -1119,11 +1121,11 @@ let prove_princ_for_struct (evd:Evd.evar_map ref) interactive_proof fun_num fnam
 	)
     in
     observe (str "full_params := " ++
-	       prlist_with_sep spc (fun decl -> Ppconstr.pr_id (Nameops.out_name (get_name decl)))
+	       prlist_with_sep spc (RelDecl.get_name %> Nameops.out_name %> Ppconstr.pr_id)
 	       full_params
 	    );
     observe (str "princ_params := " ++
-	       prlist_with_sep spc (fun decl -> Ppconstr.pr_id (Nameops.out_name (get_name decl)))
+	       prlist_with_sep spc (RelDecl.get_name %> Nameops.out_name %> Ppconstr.pr_id)
 	       princ_params
 	    );
     observe (str "fbody_with_full_params := " ++
@@ -1165,7 +1167,7 @@ let prove_princ_for_struct (evd:Evd.evar_map ref) interactive_proof fun_num fnam
 	    let pte_to_fix,rev_info =
 	      List.fold_left_i
 		(fun i (acc_map,acc_info) decl ->
-		   let pte = get_name decl in
+		   let pte = RelDecl.get_name decl in
 		   let infos = info_array.(i) in
 		   let type_args,_ = decompose_prod infos.types in
 		   let nargs = List.length type_args in
@@ -1277,7 +1279,7 @@ let prove_princ_for_struct (evd:Evd.evar_map ref) interactive_proof fun_num fnam
 		       (do_replace evd
 			  full_params
 			  (fix_info.idx + List.length princ_params)
-			  (args_id@(List.map (fun decl -> Nameops.out_name (get_name decl)) princ_params))
+			  (args_id@(List.map (RelDecl.get_name %> Nameops.out_name) princ_params))
 			  (all_funs.(fix_info.num_in_block))
 			  fix_info.num_in_block
 			  all_funs
@@ -1556,7 +1558,7 @@ let prove_principle_for_gen
       | _ -> assert false
   in
 (*   observe (str "rec_arg_id := " ++ pr_lconstr (mkVar rec_arg_id)); *)
-  let subst_constrs = List.map (fun decl -> mkVar (Nameops.out_name (get_name decl))) (pre_rec_arg@princ_info.params) in
+  let subst_constrs = List.map (get_name %> Nameops.out_name %> mkVar) (pre_rec_arg@princ_info.params) in
   let relation = substl subst_constrs relation in
   let input_type = substl subst_constrs rec_arg_type in
   let wf_thm_id = Nameops.out_name (fresh_id (Name (Id.of_string "wf_R"))) in
@@ -1584,7 +1586,7 @@ let prove_principle_for_gen
       )
       g
   in
-  let args_ids = List.map (fun decl -> Nameops.out_name (get_name decl)) princ_info.args in
+  let args_ids = List.map (get_name %> Nameops.out_name) princ_info.args in
   let lemma =
     match !tcc_lemma_ref with
      | None -> error "No tcc proof !!"
@@ -1631,7 +1633,7 @@ let prove_principle_for_gen
     [
       observe_tac "start_tac" start_tac;
       h_intros
-	(List.rev_map (fun decl -> Nameops.out_name (get_name decl))
+	(List.rev_map (get_name %> Nameops.out_name)
 	   (princ_info.args@princ_info.branches@princ_info.predicates@princ_info.params)
 	);
       (* observe_tac "" *) Proofview.V82.of_tactic (assert_by
@@ -1669,7 +1671,7 @@ let prove_principle_for_gen
 	 in
 	 let acc_inv = lazy (mkApp(Lazy.force acc_inv, [|mkVar  acc_rec_arg_id|])) in
 	 let predicates_names =
-	   List.map (fun decl -> Nameops.out_name (get_name decl)) princ_info.predicates
+	   List.map (get_name %> Nameops.out_name) princ_info.predicates
 	 in
 	 let pte_info =
 	   { proving_tac =
@@ -1685,7 +1687,7 @@ let prove_principle_for_gen
 		       is_mes acc_inv fix_id
 
 		       (!tcc_list@(List.map
-			   (fun decl -> (Nameops.out_name (get_name decl)))
+			   (get_name %> Nameops.out_name)
 			   (princ_info.args@princ_info.params)
 			)@ ([acc_rec_arg_id])) eqs
 		    )
@@ -1714,7 +1716,7 @@ let prove_principle_for_gen
 	 (* observe_tac "instanciate_hyps_with_args"  *)
 	   (instanciate_hyps_with_args
 	      make_proof
-	      (List.map (fun decl -> Nameops.out_name (get_name decl)) princ_info.branches)
+	      (List.map (get_name %> Nameops.out_name) princ_info.branches)
 	      (List.rev args_ids)
 	   )
 	   gl'
diff --git a/plugins/funind/functional_principles_types.ml b/plugins/funind/functional_principles_types.ml
index 5b4fb2595..cc699e5d3 100644
--- a/plugins/funind/functional_principles_types.ml
+++ b/plugins/funind/functional_principles_types.ml
@@ -1,5 +1,5 @@
 open Printer
-open Errors
+open CErrors
 open Util
 open Term
 open Vars
@@ -14,6 +14,8 @@ open Functional_principles_proofs
 open Misctypes
 open Sigma.Notations
 
+module RelDecl = Context.Rel.Declaration
+
 exception Toberemoved_with_rel of int*constr
 exception Toberemoved
 
@@ -38,7 +40,7 @@ let compute_new_princ_type_from_rel rel_to_fun sorts princ_type =
 	| Name x ->
 	   let id = Namegen.next_ident_away x avoid in
 	   Hashtbl.add tbl id x;
-	   set_name (Name id) decl :: change_predicates_names (id::avoid) predicates
+	   RelDecl.set_name (Name id) decl :: change_predicates_names (id::avoid) predicates
 	| Anonymous -> anomaly (Pp.str "Anonymous property binder "))
   in
   let avoid = (Termops.ids_of_context env_with_params ) in
@@ -51,7 +53,7 @@ let compute_new_princ_type_from_rel rel_to_fun sorts princ_type =
 (*   observe (str "princ_infos : " ++ pr_elim_scheme princ_type_info); *)
   let change_predicate_sort i decl =
     let new_sort = sorts.(i) in
-    let args,_ = decompose_prod (get_type decl) in
+    let args,_ = decompose_prod (RelDecl.get_type decl) in
     let real_args =
       if princ_type_info.indarg_in_concl
       then List.tl args
@@ -358,7 +360,7 @@ let generate_functional_principle (evd: Evd.evar_map ref)
      Don't forget to close the goal if an error is raised !!!!
   *)
   save false new_princ_name entry g_kind hook
-  with e when Errors.noncritical e ->
+  with e when CErrors.noncritical e ->
     begin
       begin
 	try
@@ -370,7 +372,7 @@ let generate_functional_principle (evd: Evd.evar_map ref)
 	  then Pfedit.delete_current_proof ()
 	  else ()
 	  else ()
-	with e when Errors.noncritical e -> ()
+	with e when CErrors.noncritical e -> ()
       end;
       raise (Defining_principle e)
     end
@@ -400,7 +402,7 @@ let get_funs_constant mp dp =
       match Global.body_of_constant const with
 	| Some body ->
 	    let body = Tacred.cbv_norm_flags
-	      (Closure.RedFlags.mkflags [Closure.RedFlags.fZETA])
+	      (CClosure.RedFlags.mkflags [CClosure.RedFlags.fZETA])
 	      (Global.env ())
 	      (Evd.from_env (Global.env ()))
 	      body
@@ -510,7 +512,7 @@ let make_scheme evd (fas : (pconstant*glob_sort) list) : Safe_typing.private_con
 	0
 	(prove_princ_for_struct evd false 0 (Array.of_list (List.map fst funs)))
 	(fun _ _ _ -> ())
-    with e when Errors.noncritical e ->
+    with e when CErrors.noncritical e ->
        begin
 	 begin
 	   try
@@ -522,7 +524,7 @@ let make_scheme evd (fas : (pconstant*glob_sort) list) : Safe_typing.private_con
 		  then Pfedit.delete_current_proof ()
 		  else ()
 	     else ()
-	   with e when Errors.noncritical e -> ()
+	   with e when CErrors.noncritical e -> ()
 	 end;
 	 raise (Defining_principle e)
        end
@@ -609,7 +611,7 @@ let build_scheme fas =
 	      try
 		Smartlocate.global_with_alias f
 	      with Not_found ->
-                errorlabstrm "FunInd.build_scheme"
+                user_err ~hdr:"FunInd.build_scheme"
                   (str "Cannot find " ++ Libnames.pr_reference f)
 	    in
 	    let evd',f = Evd.fresh_global (Global.env ()) !evd f_as_constant in
@@ -643,7 +645,7 @@ let build_case_scheme fa =
     let (_,f,_) = fa in
     try fst (Universes.unsafe_constr_of_global (Smartlocate.global_with_alias f))
     with Not_found ->
-      errorlabstrm "FunInd.build_case_scheme"
+      user_err ~hdr:"FunInd.build_case_scheme"
         (str "Cannot find " ++ Libnames.pr_reference f) in
   let first_fun,u = destConst  funs in
   let funs_mp,funs_dp,_ = Names.repr_con first_fun in
diff --git a/plugins/funind/g_indfun.ml4 b/plugins/funind/g_indfun.ml4
index c63527dea..6603a95a8 100644
--- a/plugins/funind/g_indfun.ml4
+++ b/plugins/funind/g_indfun.ml4
@@ -14,11 +14,11 @@ open Constrexpr
 open Indfun_common
 open Indfun
 open Genarg
-open Constrarg
+open Stdarg
 open Misctypes
 open Pcoq.Prim
 open Pcoq.Constr
-open Pcoq.Tactic
+open Pltac
 
 DECLARE PLUGIN "recdef_plugin"
 
@@ -90,7 +90,7 @@ let pr_intro_as_pat _prc _ _ pat =
 
 let out_disjunctive = function
   | loc, IntroAction (IntroOrAndPattern l) -> (loc,l)
-  | _ -> Errors.error "Disjunctive or conjunctive intro pattern expected."
+  | _ -> CErrors.error "Disjunctive or conjunctive intro pattern expected."
 
 ARGUMENT EXTEND with_names TYPED AS intropattern_opt PRINTED BY pr_intro_as_pat
 |   [ "as"  simple_intropattern(ipat) ] -> [ Some ipat ]
@@ -123,12 +123,12 @@ TACTIC EXTEND snewfunind
 END
 
 
-let pr_constr_coma_sequence prc _ _ = prlist_with_sep pr_comma prc
+let pr_constr_comma_sequence prc _ _ = prlist_with_sep pr_comma prc
 
-ARGUMENT EXTEND constr_coma_sequence'
+ARGUMENT EXTEND constr_comma_sequence'
   TYPED AS constr_list
-  PRINTED BY pr_constr_coma_sequence
-| [ constr(c) "," constr_coma_sequence'(l) ] -> [ c::l ]
+  PRINTED BY pr_constr_comma_sequence
+| [ constr(c) "," constr_comma_sequence'(l) ] -> [ c::l ]
 | [ constr(c) ] -> [ [c] ]
 END
 
@@ -137,13 +137,13 @@ 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 ]
+| [ "using" constr_comma_sequence'(l) ] -> [ l ]
 | [ ] -> [ [] ]
 END
 
 module Gram = Pcoq.Gram
 module Vernac = Pcoq.Vernac_
-module Tactic = Pcoq.Tactic
+module Tactic = Pltac
 
 type function_rec_definition_loc_argtype = (Vernacexpr.fixpoint_expr * Vernacexpr.decl_notation list) Loc.located
 
@@ -162,6 +162,11 @@ GEXTEND Gram
 
 END
 
+let () =
+  let raw_printer _ _ _ (loc,body) = Ppvernac.pr_rec_definition body in
+  let printer _ _ _ _ = str "<Unavailable printer for rec_definition>" in
+  Pptactic.declare_extra_genarg_pprule wit_function_rec_definition_loc raw_printer printer printer
+
 (* TASSI: n'importe quoi ! *)
 VERNAC COMMAND EXTEND Function
    ["Function" ne_function_rec_definition_loc_list_sep(recsl,"with")]
@@ -190,18 +195,16 @@ END
 
 
 let warning_error names e =
-  let (e, _) = Cerrors.process_vernac_interp_error (e, Exninfo.null) in
+  let (e, _) = ExplainErr.process_vernac_interp_error (e, Exninfo.null) in
   match e with
     | Building_graph e ->
-	Feedback.msg_warning
-	  (str "Cannot define graph(s) for " ++
-	     h 1 (pr_enum Libnames.pr_reference names) ++
-	     if do_observe () then (spc () ++ Errors.print e) else mt ())
+       let names = pr_enum Libnames.pr_reference names in
+       let error = if do_observe () then (spc () ++ CErrors.print e) else mt () in
+       warn_cannot_define_graph (names,error)
     | Defining_principle e ->
-	Feedback.msg_warning
-	  (str "Cannot define principle(s) for "++
-	     h 1 (pr_enum Libnames.pr_reference names) ++
-	     if do_observe () then Errors.print e else mt ())
+       let names = pr_enum Libnames.pr_reference names in
+       let error = if do_observe () then CErrors.print e else mt () in
+       warn_cannot_define_principle (names,error)
     | _ -> raise e
 
 
@@ -224,15 +227,15 @@ VERNAC COMMAND EXTEND NewFunctionalScheme
 		  ;
 		    try Functional_principles_types.build_scheme fas
 		    with Functional_principles_types.No_graph_found ->
-		      Errors.error ("Cannot generate induction principle(s)")
-		      | e when Errors.noncritical e ->
+		      CErrors.error ("Cannot generate induction principle(s)")
+		      | e when CErrors.noncritical e ->
 			  let names = List.map (fun (_,na,_) -> na) fas in
 			  warning_error names e
 
 		  end
 	      | _ -> assert false (* we can only have non empty  list *)
 	  end
-	  | e when Errors.noncritical e ->
+	  | e when CErrors.noncritical e ->
 	      let names = List.map (fun (_,na,_) -> na) fas in
 	      warning_error names e
       end
diff --git a/plugins/funind/glob_term_to_relation.ml b/plugins/funind/glob_term_to_relation.ml
index c424fe122..de2e5ea4e 100644
--- a/plugins/funind/glob_term_to_relation.ml
+++ b/plugins/funind/glob_term_to_relation.ml
@@ -7,11 +7,14 @@ open Glob_term
 open Glob_ops
 open Globnames
 open Indfun_common
-open Errors
+open CErrors
 open Util
 open Glob_termops
 open Misctypes
 
+module RelDecl = Context.Rel.Declaration
+module NamedDecl = Context.Named.Declaration
+
 let observe strm =
   if do_observe ()
   then Feedback.msg_debug strm
@@ -333,19 +336,20 @@ let raw_push_named (na,raw_value,raw_typ) env =
   match na with
     | Anonymous -> env
     | Name id ->
-	let value = Option.map (fun x-> fst (Pretyping.understand env (Evd.from_env env) x)) raw_value in
-	let typ,ctx = Pretyping.understand env (Evd.from_env env) ~expected_type:Pretyping.IsType raw_typ in
-        let open Context.Named.Declaration in
-	Environ.push_named (of_tuple (id,value,typ)) env
+        let typ,_ = Pretyping.understand env (Evd.from_env env) ~expected_type:Pretyping.IsType raw_typ in
+        (match raw_value with
+        | None ->
+           Environ.push_named (NamedDecl.LocalAssum (id,typ)) env
+        | Some value ->
+           Environ.push_named (NamedDecl.LocalDef (id, value, typ)) env)
 
 
 let add_pat_variables pat typ env : Environ.env =
   let rec add_pat_variables env pat typ  : Environ.env =
-    let open Context.Rel.Declaration in
     observe (str "new rel env := " ++ Printer.pr_rel_context_of env (Evd.from_env env));
 
     match pat with
-      | PatVar(_,na) -> Environ.push_rel (LocalAssum (na,typ)) env
+      | PatVar(_,na) -> Environ.push_rel (RelDecl.LocalAssum (na,typ)) env
       | PatCstr(_,c,patl,na) ->
 	  let Inductiveops.IndType(indf,indargs) =
 	    try Inductiveops.find_rectype env (Evd.from_env env) typ
@@ -353,7 +357,7 @@ let add_pat_variables pat typ env : Environ.env =
 	  in
 	  let constructors = Inductiveops.get_constructors env indf in
 	  let constructor : Inductiveops.constructor_summary = List.find (fun cs -> eq_constructor c (fst cs.Inductiveops.cs_cstr)) (Array.to_list constructors) in
-	  let cs_args_types :types list = List.map get_type constructor.Inductiveops.cs_args in
+	  let cs_args_types :types list = List.map RelDecl.get_type constructor.Inductiveops.cs_args in
 	  List.fold_left2 add_pat_variables env patl (List.rev cs_args_types)
   in
   let new_env = add_pat_variables  env pat typ in
@@ -361,20 +365,28 @@ let add_pat_variables pat typ env : Environ.env =
     fst (
       Context.Rel.fold_outside
 	(fun decl (env,ctxt) ->
-         let _,v,t = Context.Rel.Declaration.to_tuple decl in
-	 match Context.Rel.Declaration.get_name decl with
-	   | Anonymous -> assert false
-	   | Name id ->
+         let open Context.Rel.Declaration in
+	 match decl with
+	   | LocalAssum (Anonymous,_) | LocalDef (Anonymous,_,_) -> assert false
+	   | LocalAssum (Name id, t) ->
+	       let new_t =  substl ctxt t in
+	       observe (str "for variable " ++ Ppconstr.pr_id id ++  fnl () ++
+			  str "old type := " ++ Printer.pr_lconstr t ++ fnl () ++
+			  str "new type := " ++ Printer.pr_lconstr new_t ++ fnl ()
+		       );
+               let open Context.Named.Declaration in
+	       (Environ.push_named (LocalAssum (id,new_t)) env,mkVar id::ctxt)
+	   | LocalDef (Name id, v, t) ->
 	       let new_t =  substl ctxt t in
-	       let new_v = Option.map (substl ctxt) v in
+	       let new_v = substl ctxt v in
 	       observe (str "for variable " ++ Ppconstr.pr_id id ++  fnl () ++
 			  str "old type := " ++ Printer.pr_lconstr t ++ fnl () ++
 			  str "new type := " ++ Printer.pr_lconstr new_t ++ fnl () ++
-			  Option.fold_right (fun v _ -> str "old value := " ++ Printer.pr_lconstr v ++ fnl ()) v (mt ()) ++
-			  Option.fold_right (fun v _ -> str "new value := " ++ Printer.pr_lconstr v ++ fnl ()) new_v (mt ())
+			  str "old value := " ++ Printer.pr_lconstr v ++ fnl () ++
+			  str "new value := " ++ Printer.pr_lconstr new_v ++ fnl ()
 		       );
                let open Context.Named.Declaration in
-	       (Environ.push_named (of_tuple (id,new_v,new_t)) env,mkVar id::ctxt)
+	       (Environ.push_named (LocalDef (id,new_v,new_t)) env,mkVar id::ctxt)
       )
 	(Environ.rel_context new_env)
 	~init:(env,[])
@@ -402,8 +414,7 @@ let rec pattern_to_term_and_type env typ  = function
       in
       let constructors = Inductiveops.get_constructors env indf in
       let constructor  = List.find (fun cs -> eq_constructor (fst cs.Inductiveops.cs_cstr) constr) (Array.to_list constructors) in
-      let open Context.Rel.Declaration in
-      let cs_args_types :types list = List.map get_type constructor.Inductiveops.cs_args in
+      let cs_args_types :types list = List.map RelDecl.get_type constructor.Inductiveops.cs_args in
       let _,cstl = Inductiveops.dest_ind_family indf in
       let csta = Array.of_list cstl in
       let implicit_args =
@@ -602,10 +613,9 @@ let rec build_entry_lc env funnames avoid rt  : glob_constr build_entry_return =
 	let v_as_constr,ctx = Pretyping.understand env (Evd.from_env env) v in
 	let v_type = Typing.unsafe_type_of env (Evd.from_env env) v_as_constr in
 	let new_env =
-          let open Context.Named.Declaration in
 	  match n with
 	      Anonymous -> env
-	    | Name id -> Environ.push_named (of_tuple (id,Some v_as_constr,v_type)) env
+	    | Name id -> Environ.push_named (NamedDecl.LocalDef (id,v_as_constr,v_type)) env
 	in
 	let b_res = build_entry_lc new_env funnames avoid b in
 	combine_results (combine_letin n) v_res b_res
@@ -621,7 +631,7 @@ let rec build_entry_lc env funnames avoid rt  : glob_constr build_entry_return =
 	let (ind,_) =
 	  try Inductiveops.find_inductive env (Evd.from_env env) b_typ
 	  with Not_found ->
-	    errorlabstrm "" (str "Cannot find the inductive associated to " ++
+	    user_err  (str "Cannot find the inductive associated to " ++
 			       Printer.pr_glob_constr b ++ str " in " ++
 			       Printer.pr_glob_constr rt ++ str ". try again with a cast")
 	in
@@ -653,7 +663,7 @@ let rec build_entry_lc env funnames avoid rt  : glob_constr build_entry_return =
 	  let (ind,_) =
 	    try Inductiveops.find_inductive env (Evd.from_env env) b_typ
 	    with Not_found ->
-	      errorlabstrm "" (str "Cannot find the inductive associated to " ++
+	      user_err  (str "Cannot find the inductive associated to " ++
 				 Printer.pr_glob_constr b ++ str " in " ++
 				 Printer.pr_glob_constr rt ++ str ". try again with a cast")
 	  in
@@ -921,7 +931,7 @@ let rec rebuild_cons env nb_args relname args crossed_types depth rt =
 		    observe (str "computing new type for eq : " ++ pr_glob_constr rt);
 		    let t' =
 		      try fst (Pretyping.understand env (Evd.from_env env) t)(*FIXME*)
-                      with e when Errors.noncritical e -> raise Continue
+                      with e when CErrors.noncritical e -> raise Continue
 		    in
 		    let is_in_b = is_free_in id b in
 		    let _keep_eq =
@@ -976,8 +986,7 @@ let rec rebuild_cons env nb_args relname args crossed_types depth rt =
 			      (fun acc var_as_constr arg ->
 				 if isRel var_as_constr
 				 then
-                                   let open Context.Rel.Declaration in
-				   let na = get_name (Environ.lookup_rel (destRel var_as_constr) env) in
+				   let na = RelDecl.get_name (Environ.lookup_rel (destRel var_as_constr) env) in
 				   match na with
 				     | Anonymous -> acc
 				     | Name id' ->
@@ -1189,7 +1198,7 @@ let rec compute_cst_params relnames params = function
   | GSort _ -> params
   | GHole _ -> params
   | GIf _ | GRec _ | GCast _ ->
-      raise (UserError("compute_cst_params", str "Not handled case"))
+      raise (UserError(Some "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 ! *)
@@ -1223,7 +1232,7 @@ let compute_params_name relnames (args : (Name.t * Glob_term.glob_constr * bool)
 	     l := param::!l
 	)
 	rels_params.(0)
-    with e when Errors.noncritical e ->
+    with e when CErrors.noncritical e ->
       ()
   in
   List.rev !l
@@ -1460,7 +1469,7 @@ let do_build_inductive
 	  str "while trying to define"++ spc () ++
 	    Ppvernac.pr_vernac (Vernacexpr.VernacInductive(false,Decl_kinds.Finite,repacked_rel_inds))
 	    ++ fnl () ++
-	    Errors.print reraise
+	    CErrors.print reraise
 	in
  	observe msg;
 	raise reraise
@@ -1476,7 +1485,7 @@ let build_inductive evd funconstants funsargs returned_types rtl =
     do_build_inductive evd funconstants funsargs returned_types rtl;
     Detyping.print_universes := pu;
     Constrextern.print_universes := cu
-  with e when Errors.noncritical e ->
+  with e when CErrors.noncritical e ->
     Detyping.print_universes := pu;
     Constrextern.print_universes := cu;
     raise (Building_graph e)
diff --git a/plugins/funind/glob_termops.ml b/plugins/funind/glob_termops.ml
index 291f835ee..4e561fc7e 100644
--- a/plugins/funind/glob_termops.ml
+++ b/plugins/funind/glob_termops.ml
@@ -1,6 +1,6 @@
 open Pp
 open Glob_term
-open Errors
+open CErrors
 open Util
 open Names
 open Decl_kinds
@@ -406,7 +406,7 @@ let is_free_in id =
 
     | GIf(_,cond,_,br1,br2) ->
 	is_free_in cond || is_free_in br1 || is_free_in br2
-    | GRec _ -> raise (UserError("",str "Not handled GRec"))
+    | GRec _ -> raise (UserError(None,str "Not handled GRec"))
     | GSort _ -> false
     | GHole _ -> false
     | GCast (_,b,(CastConv t|CastVM t|CastNative t)) -> is_free_in b || is_free_in t
@@ -502,7 +502,7 @@ let replace_var_by_term x_id term =
 	      replace_var_by_pattern lhs,
 	      replace_var_by_pattern rhs
 	     )
-      | GRec _ -> raise (UserError("",str "Not handled GRec"))
+      | GRec _ -> raise (UserError(None,str "Not handled GRec"))
       | GSort _ -> rt
       | GHole _ -> rt
       | GCast(loc,b,c) ->
@@ -655,7 +655,7 @@ let zeta_normalize =
 	      zeta_normalize_term lhs,
 	      zeta_normalize_term rhs
 	     )
-      | GRec _ -> raise (UserError("",str "Not handled GRec"))
+      | GRec _ -> raise (UserError(None,str "Not handled GRec"))
       | GSort _ -> rt
       | GHole _ -> rt
       | GCast(loc,b,c) ->
diff --git a/plugins/funind/indfun.ml b/plugins/funind/indfun.ml
index 0cacb003d..99b04898b 100644
--- a/plugins/funind/indfun.ml
+++ b/plugins/funind/indfun.ml
@@ -1,5 +1,4 @@
-open Context.Rel.Declaration
-open Errors
+open CErrors
 open Util
 open Names
 open Term
@@ -13,11 +12,13 @@ open Misctypes
 open Decl_kinds
 open Sigma.Notations
 
+module RelDecl = Context.Rel.Declaration
+
 let is_rec_info scheme_info =
   let test_branche min acc decl =
     acc || (
       let new_branche =
-	it_mkProd_or_LetIn mkProp (fst (decompose_prod_assum (get_type decl))) in
+	it_mkProd_or_LetIn mkProp (fst (decompose_prod_assum (RelDecl.get_type decl))) in
       let free_rels_in_br = Termops.free_rels new_branche in
       let max = min + scheme_info.Tactics.npredicates in
       Int.Set.exists (fun i -> i >= min && i< max) free_rels_in_br
@@ -42,7 +43,7 @@ let functional_induction with_clean c princl pat =
 		let finfo = (* we first try to find out a graph on f *)
 		  try find_Function_infos c'
 		  with Not_found ->
-		    errorlabstrm "" (str "Cannot find induction information on "++
+		    user_err  (str "Cannot find induction information on "++
 				       Printer.pr_lconstr (mkConst c') )
 		in
 		match Tacticals.elimination_sort_of_goal g with
@@ -70,11 +71,11 @@ let functional_induction with_clean c princl pat =
 		    (b,a)
 		    (* mkConst(const_of_id princ_name ),g (\* FIXME *\) *)
 		  with Not_found -> (* This one is neither defined ! *)
-		    errorlabstrm "" (str "Cannot find induction principle for "
+		    user_err  (str "Cannot find induction principle for "
 				     ++Printer.pr_lconstr (mkConst c') )
 	      in
 	      (princ,NoBindings, Tacmach.pf_unsafe_type_of g' princ,g')
-	   | _ -> raise (UserError("",str "functional induction must be used with a function" ))
+	   | _ -> raise (UserError(None,str "functional induction must be used with a function" ))
 	 end
       | Some ((princ,binding)) ->
 	 princ,binding,Tacmach.pf_unsafe_type_of g princ,g
@@ -132,6 +133,7 @@ let rec abstract_glob_constr c = function
   | Constrexpr.LocalRawAssum (idl,k,t)::bl ->
       List.fold_right (fun x b -> Constrexpr_ops.mkLambdaC([x],k,t,b)) idl
         (abstract_glob_constr c bl)
+  | Constrexpr.LocalPattern _::bl -> assert false
 
 let interp_casted_constr_with_implicits env sigma impls c  =
   Constrintern.intern_gen Pretyping.WithoutTypeConstraint env ~impls
@@ -174,7 +176,7 @@ let build_newrecursive l =
        match body_opt with 
 	 | Some body -> 
 	     (fixna,bll,ar,body)
-	 | None -> user_err_loc (Loc.ghost,"Function",str "Body of Function must be given")
+	 | None -> user_err ~hdr:"Function" (str "Body of Function must be given")
     ) l
   in
   build_newrecursive l'
@@ -215,6 +217,7 @@ let rec local_binders_length = function
   | [] -> 0
   | Constrexpr.LocalRawDef _::bl -> 1 + local_binders_length bl
   | Constrexpr.LocalRawAssum (idl,_,_)::bl -> List.length idl + local_binders_length bl
+  | Constrexpr.LocalPattern _::bl -> assert false
 
 let prepare_body ((name,_,args,types,_),_) rt =
   let n = local_binders_length args in
@@ -223,7 +226,12 @@ let prepare_body ((name,_,args,types,_),_) rt =
   (fun_args,rt')
 
 let process_vernac_interp_error e =
-  fst (Cerrors.process_vernac_interp_error (e, Exninfo.null))
+  fst (ExplainErr.process_vernac_interp_error (e, Exninfo.null))
+
+let warn_funind_cannot_build_inversion =
+  CWarnings.create ~name:"funind-cannot-build-inversion" ~category:"funind"
+    (fun e' -> strbrk "Cannot build inversion information" ++
+                 if do_observe () then (fnl() ++ CErrors.print e') else mt ())
 
 let derive_inversion fix_names =
   try
@@ -265,16 +273,22 @@ let derive_inversion fix_names =
 	functional_induction
 	fix_names_as_constant
 	lind;
-      with e when Errors.noncritical e ->
-      let e' = process_vernac_interp_error e in
-      Feedback.msg_warning
-	(str "Cannot build inversion information" ++
-	   if do_observe () then (fnl() ++ Errors.print e') else mt ())
-  with e when Errors.noncritical e ->
+      with e when CErrors.noncritical e ->
       let e' = process_vernac_interp_error e in
-      Feedback.msg_warning
-	(str "Cannot build inversion information (early)" ++
-	   if do_observe () then (fnl() ++ Errors.print e') else mt ())       
+      warn_funind_cannot_build_inversion e'
+  with e when CErrors.noncritical e ->
+    let e' = process_vernac_interp_error e in
+    warn_funind_cannot_build_inversion e'
+
+let warn_cannot_define_graph =
+  CWarnings.create ~name:"funind-cannot-define-graph" ~category:"funind"
+    (fun (names,error) -> strbrk "Cannot define graph(s) for " ++
+      h 1 names ++ error)
+
+let warn_cannot_define_principle =
+  CWarnings.create ~name:"funind-cannot-define-principle" ~category:"funind"
+  (fun (names,error) -> strbrk "Cannot define induction principle(s) for "++
+      h 1 names ++ error)
 
 let warning_error names e =
   let e = process_vernac_interp_error e in
@@ -282,37 +296,33 @@ let warning_error names e =
     match e with
       | ToShow e -> 
 	let e = process_vernac_interp_error e in
-	spc () ++ Errors.print e
+	spc () ++ CErrors.print e
       | _ -> 
 	if do_observe () 
 	then 
 	  let e = process_vernac_interp_error e in 
-	  (spc () ++ Errors.print e) 
+	  (spc () ++ CErrors.print e)
 	else mt ()
   in
   match e with
     | Building_graph e ->
-      Feedback.msg_warning
-	(str "Cannot define graph(s) for " ++
-	   h 1 (prlist_with_sep (fun _ -> str","++spc ()) Ppconstr.pr_id names) ++
-	   e_explain e)
+       let names = prlist_with_sep (fun _ -> str","++spc ()) Ppconstr.pr_id names in
+       warn_cannot_define_graph (names,e_explain e)
     | Defining_principle e ->
-      Feedback.msg_warning
-	(str "Cannot define principle(s) for "++
-	   h 1 (prlist_with_sep (fun _ -> str","++spc ()) Ppconstr.pr_id names) ++
-	   e_explain e)
+       let names = prlist_with_sep (fun _ -> str","++spc ()) Ppconstr.pr_id names in
+       warn_cannot_define_principle (names,e_explain e)
     | _ -> raise e
 
 let error_error names e =
   let e = process_vernac_interp_error e in
   let e_explain e =
     match e with
-      | ToShow e -> spc () ++ Errors.print e
-      | _ -> if do_observe () then (spc () ++ Errors.print e) else mt ()
+      | ToShow e -> spc () ++ CErrors.print e
+      | _ -> if do_observe () then (spc () ++ CErrors.print e) else mt ()
   in
   match e with
     | Building_graph e ->
-	errorlabstrm ""
+	user_err 
 	  (str "Cannot define graph(s) for " ++
 	     h 1 (prlist_with_sep (fun _ -> str","++spc ()) Ppconstr.pr_id names) ++
 	     e_explain e)
@@ -376,13 +386,13 @@ let generate_principle (evd:Evd.evar_map ref) pconstants on_error
 	Array.iter (add_Function is_general) funs_kn;
 	()
       end
-  with e when Errors.noncritical e ->
+  with e when CErrors.noncritical e ->
     on_error names e
 
 let register_struct is_rec (fixpoint_exprl:(Vernacexpr.fixpoint_expr * Vernacexpr.decl_notation list) list) =
   match fixpoint_exprl with
     | [(((_,fname),pl),_,bl,ret_type,body),_] when not is_rec ->
-      let body = match body with | Some body -> body | None -> user_err_loc (Loc.ghost,"Function",str "Body of Function must be given") in 
+      let body = match body with | Some body -> body | None -> user_err ~hdr:"Function" (str "Body of Function must be given") in 
       Command.do_definition
 	fname
 	(Decl_kinds.Global,(Flags.is_universe_polymorphism ()),Decl_kinds.Definition) pl
@@ -466,7 +476,7 @@ let register_wf ?(is_mes=false) fname rec_impls wf_rel_expr wf_arg using_lemmas
 	   functional_ref eq_ref rec_arg_num rec_arg_type nb_args relation
 	);
       derive_inversion [fname]
-    with e when Errors.noncritical e ->
+    with e when CErrors.noncritical e ->
       (* No proof done *)
       ()
   in
@@ -621,7 +631,7 @@ let do_generate_principle pconstants on_error register_built interactive_proof
 	      | _ -> assert false
 	  in 
 	  let fixpoint_exprl = [fixpoint_expr] in 
-	  let body = match body with | Some body -> body | None -> user_err_loc (Loc.ghost,"Function",str "Body of Function must be given") in 
+	  let body = match body with | Some body -> body | None -> user_err ~hdr:"Function" (str "Body of Function must be given") in 
 	  let recdefs,rec_impls = build_newrecursive fixpoint_exprl in
 	  let using_lemmas = [] in 
 	  let pre_hook pconstants =
@@ -647,7 +657,7 @@ let do_generate_principle pconstants on_error register_built interactive_proof
 	  let fixpoint_exprl = [fixpoint_expr] in 
 	  let recdefs,rec_impls = build_newrecursive fixpoint_exprl in
 	  let using_lemmas = [] in
-	  let body = match body with | Some body -> body | None -> user_err_loc (Loc.ghost,"Function",str "Body of Function must be given") in 
+	  let body = match body with | Some body -> body | None -> user_err ~hdr:"Function" (str "Body of Function must be given") in 
 	  let pre_hook pconstants =
 	    generate_principle
 	      (ref (Evd.from_env (Global.env ())))
@@ -825,9 +835,9 @@ let make_graph (f_ref:global_reference) =
       | ConstRef c ->
 	  begin try c,Global.lookup_constant c
 	  with Not_found ->
-	    raise (UserError ("",str "Cannot find " ++ Printer.pr_lconstr (mkConst c)) )
+	    raise (UserError (None,str "Cannot find " ++ Printer.pr_lconstr (mkConst c)) )
 	  end
-      | _ -> raise (UserError ("", str "Not a function reference") )
+      | _ -> raise (UserError (None, str "Not a function reference") )
   in
   (match Global.body_of_constant_body c_body with
      | None -> error "Cannot build a graph over an axiom !"
@@ -861,6 +871,7 @@ let make_graph (f_ref:global_reference) =
 					(fun (loc,n) ->
 					   CRef(Libnames.Ident(loc, Nameops.out_name n),None))
 					nal
+                                  | Constrexpr.LocalPattern _ -> assert false
 			       )
 			       nal_tas
 			    )
diff --git a/plugins/funind/indfun.mli b/plugins/funind/indfun.mli
index e72069140..1c27bdfac 100644
--- a/plugins/funind/indfun.mli
+++ b/plugins/funind/indfun.mli
@@ -1,5 +1,9 @@
 open Misctypes
 
+val warn_cannot_define_graph : ?loc:Loc.t -> Pp.std_ppcmds * Pp.std_ppcmds -> unit
+
+val warn_cannot_define_principle : ?loc:Loc.t -> Pp.std_ppcmds * Pp.std_ppcmds -> unit
+
 val do_generate_principle :  
   bool -> 
   (Vernacexpr.fixpoint_expr * Vernacexpr.decl_notation list) list -> 
diff --git a/plugins/funind/indfun_common.ml b/plugins/funind/indfun_common.ml
index 2449678a1..a45effb16 100644
--- a/plugins/funind/indfun_common.ml
+++ b/plugins/funind/indfun_common.ml
@@ -49,7 +49,7 @@ let locate_constant ref =
 
 let locate_with_msg msg f x =
   try f x
-  with Not_found -> raise (Errors.UserError("", msg))
+  with Not_found -> raise (CErrors.UserError(None, msg))
 
 
 let filter_map filter f =
@@ -73,7 +73,7 @@ let chop_rlambda_n  =
 	  | Glob_term.GLambda(_,name,k,t,b) -> chop_lambda_n ((name,t,false)::acc) (n-1) b
 	  | Glob_term.GLetIn(_,name,v,b) -> chop_lambda_n ((name,v,true)::acc) (n-1) b
 	  | _ ->
-	      raise (Errors.UserError("chop_rlambda_n",
+	      raise (CErrors.UserError(Some "chop_rlambda_n",
 				    str "chop_rlambda_n: Not enough Lambdas"))
   in
   chop_lambda_n []
@@ -85,7 +85,7 @@ let chop_rprod_n  =
       else
 	match rt with
 	  | Glob_term.GProd(_,name,k,t,b) -> chop_prod_n ((name,t)::acc) (n-1) b
-	  | _ -> raise (Errors.UserError("chop_rprod_n",str "chop_rprod_n: Not enough products"))
+	  | _ -> raise (CErrors.UserError(Some "chop_rprod_n",str "chop_rprod_n: Not enough products"))
   in
   chop_prod_n []
 
@@ -110,7 +110,7 @@ let const_of_id id =
   in
   try Constrintern.locate_reference princ_ref
   with Not_found ->
-    Errors.errorlabstrm "IndFun.const_of_id"
+    CErrors.user_err ~hdr:"IndFun.const_of_id"
       (str "cannot find " ++ Nameops.pr_id id)
 
 let def_of_const t =
@@ -344,7 +344,7 @@ let pr_info f_info =
   (try
      Printer.pr_lconstr
        (Global.type_of_global_unsafe (ConstRef f_info.function_constant))
-   with e when Errors.noncritical e -> mt ()) ++ fnl () ++
+   with e when CErrors.noncritical e -> mt ()) ++ fnl () ++
   str "equation_lemma := " ++ pr_ocst f_info.equation_lemma ++ fnl () ++
   str "completeness_lemma :=" ++ pr_ocst f_info.completeness_lemma ++ fnl () ++
   str "correctness_lemma := " ++ pr_ocst f_info.correctness_lemma ++ fnl () ++
@@ -371,7 +371,7 @@ let in_Function : function_info -> Libobject.obj =
 
 let find_or_none id =
   try Some
-    (match Nametab.locate (qualid_of_ident id) with ConstRef c -> c | _ -> Errors.anomaly (Pp.str "Not a constant")
+    (match Nametab.locate (qualid_of_ident id) with ConstRef c -> c | _ -> CErrors.anomaly (Pp.str "Not a constant")
     )
   with Not_found -> None
 
@@ -399,7 +399,7 @@ let add_Function is_general f =
   and prop_lemma = find_or_none (Nameops.add_suffix f_id "_ind")
   and graph_ind =
     match Nametab.locate (qualid_of_ident (mk_rel_id f_id))
-    with | IndRef ind -> ind | _ -> Errors.anomaly (Pp.str "Not an inductive")
+    with | IndRef ind -> ind | _ -> CErrors.anomaly (Pp.str "Not an inductive")
   in
   let finfos =
     { function_constant = f;
@@ -476,13 +476,13 @@ let jmeq () =
   try
     Coqlib.check_required_library Coqlib.jmeq_module_name;
     Coqlib.gen_constant "Function" ["Logic";"JMeq"] "JMeq"
-  with e when Errors.noncritical e -> raise (ToShow e)
+  with e when CErrors.noncritical e -> raise (ToShow e)
 
 let jmeq_refl () =
   try
     Coqlib.check_required_library Coqlib.jmeq_module_name;
     Coqlib.gen_constant "Function" ["Logic";"JMeq"] "JMeq_refl"
-  with e when Errors.noncritical e -> raise (ToShow e)
+  with e when CErrors.noncritical e -> raise (ToShow e)
 
 let h_intros l =
   tclMAP (fun x -> Proofview.V82.of_tactic (Tactics.Simple.intro x)) l
diff --git a/plugins/funind/invfun.ml b/plugins/funind/invfun.ml
index 94530bfde..c8b4e4833 100644
--- a/plugins/funind/invfun.ml
+++ b/plugins/funind/invfun.ml
@@ -8,7 +8,7 @@
 
 open Tacexpr
 open Declarations
-open Errors
+open CErrors
 open Util
 open Names
 open Term
@@ -23,6 +23,8 @@ open Misctypes
 open Termops
 open Context.Rel.Declaration
 
+module RelDecl = Context.Rel.Declaration
+
 (* Some pretty printing function for debugging purpose *)
 
 let pr_binding prc  =
@@ -65,16 +67,16 @@ let observe strm =
 let do_observe_tac s tac g =
   let goal =
     try Printer.pr_goal g
-    with e when Errors.noncritical e -> assert false
+    with e when CErrors.noncritical e -> assert false
   in
   try
     let v = tac g in
     msgnl (goal ++ fnl () ++ s ++(str " ")++(str "finished")); v
   with reraise ->
-    let reraise = Errors.push reraise in
-    let e = Cerrors.process_vernac_interp_error reraise in
+    let reraise = CErrors.push reraise in
+    let e = ExplainErr.process_vernac_interp_error reraise in
     observe (hov 0 (str "observation "++ s++str " raised exception " ++
-	     Errors.iprint e ++ str " on goal" ++ fnl() ++ goal ));
+	     CErrors.iprint e ++ str " on goal" ++ fnl() ++ goal ));
     iraise reraise;;
 
 
@@ -90,7 +92,7 @@ let observe_tac s tac g =
 
 (* [nf_zeta] $\zeta$-normalization of a term *)
 let nf_zeta =
-  Reductionops.clos_norm_flags  (Closure.RedFlags.mkflags [Closure.RedFlags.fZETA])
+  Reductionops.clos_norm_flags  (CClosure.RedFlags.mkflags [CClosure.RedFlags.fZETA])
     Environ.empty_env
     Evd.empty
 
@@ -137,7 +139,7 @@ let generate_type evd g_to_f f graph i =
   let fun_ctxt,res_type =
     match ctxt with
       | [] | [_] -> anomaly (Pp.str "Not a valid context")
-      | decl :: fun_ctxt -> fun_ctxt, get_type decl
+      | decl :: fun_ctxt -> fun_ctxt, RelDecl.get_type decl
   in
   let rec args_from_decl i accu = function
   | [] -> accu
@@ -148,7 +150,7 @@ let generate_type evd g_to_f f graph i =
     args_from_decl (succ i) (t :: accu) l
   in
   (*i We need to name the vars [res] and [fv] i*)
-  let filter = fun decl -> match get_name decl with
+  let filter = fun decl -> match RelDecl.get_name decl with
 			   | Name id -> Some id
 			   | Anonymous -> None
   in
@@ -269,7 +271,7 @@ let prove_fun_correct evd functional_induction funs_constr graphs_constr schemes
 	(fun decl ->
 	   List.map
 	     (fun id -> Loc.ghost, IntroNaming (IntroIdentifier id))
-	     (generate_fresh_id (Id.of_string "y") ids (List.length (fst (decompose_prod_assum (get_type decl)))))
+	     (generate_fresh_id (Id.of_string "y") ids (List.length (fst (decompose_prod_assum (RelDecl.get_type decl)))))
 	)
 	branches
     in
@@ -365,7 +367,7 @@ let prove_fun_correct evd functional_induction funs_constr graphs_constr schemes
 	    observe_tac("h_intro_patterns ")  (let l = (List.nth intro_pats (pred i)) in 
 					       match l with 
 						 | [] -> tclIDTAC 
-						 | _ -> Proofview.V82.of_tactic (intro_patterns l));
+						 | _ -> Proofview.V82.of_tactic (intro_patterns false l));
 	    (* unfolding of all the defined variables introduced by this branch *)
 	    (* observe_tac "unfolding" pre_tac; *)
 	    (* $zeta$ normalizing of the conclusion *)
@@ -399,7 +401,7 @@ let prove_fun_correct evd functional_induction funs_constr graphs_constr schemes
 	     | hres::res::decl::ctxt ->
 		let res = Termops.it_mkLambda_or_LetIn
 			    (Termops.it_mkProd_or_LetIn concl [hres;res])
-			    (LocalAssum (get_name decl, get_type decl) :: ctxt)
+			    (LocalAssum (RelDecl.get_name decl, RelDecl.get_type decl) :: ctxt)
 		in
 		res
 	)
@@ -415,7 +417,7 @@ let prove_fun_correct evd functional_induction funs_constr graphs_constr schemes
       let params_bindings,avoid =
 	List.fold_left2
 	  (fun (bindings,avoid) decl p ->
-	     let id = Namegen.next_ident_away (Nameops.out_name (get_name decl)) avoid in
+	     let id = Namegen.next_ident_away (Nameops.out_name (RelDecl.get_name decl)) avoid in
 	     p::bindings,id::avoid
 	  )
 	  ([],pf_ids_of_hyps g)
@@ -425,7 +427,7 @@ let prove_fun_correct evd functional_induction funs_constr graphs_constr schemes
       let lemmas_bindings =
 	List.rev (fst  (List.fold_left2
 	  (fun (bindings,avoid) decl p ->
-	     let id = Namegen.next_ident_away (Nameops.out_name (get_name decl)) avoid in
+	     let id = Namegen.next_ident_away (Nameops.out_name (RelDecl.get_name decl)) avoid in
 	     (nf_zeta p)::bindings,id::avoid)
 	  ([],avoid)
 	  princ_infos.predicates
@@ -585,7 +587,7 @@ let rec reflexivity_with_destruct_cases g =
 	      observe_tac "reflexivity_with_destruct_cases" reflexivity_with_destruct_cases
 	    ]
         | _ -> Proofview.V82.of_tactic reflexivity
-    with e when Errors.noncritical e -> Proofview.V82.of_tactic reflexivity
+    with e when CErrors.noncritical e -> Proofview.V82.of_tactic reflexivity
   in
   let eq_ind = make_eq () in
   let discr_inject =
@@ -682,7 +684,7 @@ let prove_fun_complete funcs graphs schemes lemmas_types_infos i : tactic =
 	(fun decl ->
 	   List.map
 	     (fun id -> id)
-	     (generate_fresh_id (Id.of_string "y") ids (nb_prod (get_type decl)))
+	     (generate_fresh_id (Id.of_string "y") ids (nb_prod (RelDecl.get_type decl)))
 	)
 	branches
     in
@@ -998,7 +1000,7 @@ let invfun qhyp f  =
   let f =
     match f with
       | ConstRef f -> f
-      | _ -> raise (Errors.UserError("",str "Not a function"))
+      | _ -> raise (CErrors.UserError(None,str "Not a function"))
   in
   try
     let finfos = find_Function_infos f in
@@ -1043,19 +1045,19 @@ let invfun qhyp f g =
 			 functional_inversion kn hid  f2 f_correct g
 		       with
 			 | Failure "" ->
-			     errorlabstrm "" (str "Hypothesis " ++ Ppconstr.pr_id hid ++ str " must contain at least one Function")
+			     user_err  (str "Hypothesis " ++ Ppconstr.pr_id hid ++ str " must contain at least one Function")
 			 | Option.IsNone  ->
 			     if do_observe ()
 			     then
 			       error "Cannot use equivalence with graph for any side of the equality"
-			     else errorlabstrm "" (str "Cannot find inversion information for hypothesis " ++ Ppconstr.pr_id hid)
+			     else user_err  (str "Cannot find inversion information for hypothesis " ++ Ppconstr.pr_id hid)
 			 | Not_found ->
 			     if do_observe ()
 			     then
 			       error "No graph found for any side of equality"
-			     else errorlabstrm "" (str "Cannot find inversion information for hypothesis " ++ Ppconstr.pr_id hid)
+			     else user_err  (str "Cannot find inversion information for hypothesis " ++ Ppconstr.pr_id hid)
 		   end
-	       | _ -> errorlabstrm "" (Ppconstr.pr_id hid ++ str " must be an equality ")
+	       | _ -> user_err  (Ppconstr.pr_id hid ++ str " must be an equality ")
 	  end)
 	  qhyp
           end
diff --git a/plugins/funind/merge.ml b/plugins/funind/merge.ml
index 99a165044..19c2ed417 100644
--- a/plugins/funind/merge.ml
+++ b/plugins/funind/merge.ml
@@ -11,7 +11,7 @@
 open Globnames
 open Tactics
 open Indfun_common
-open Errors
+open CErrors
 open Util
 open Constrexpr
 open Vernacexpr
@@ -26,6 +26,8 @@ open Glob_termops
 open Decl_kinds
 open Context.Rel.Declaration
 
+module RelDecl = Context.Rel.Declaration
+
 (** {1 Utilities}  *)
 
 (** {2 Useful operations on constr and glob_constr} *)
@@ -57,8 +59,8 @@ let understand = Pretyping.understand (Global.env()) Evd.empty
 let id_of_name = function
     Anonymous -> Id.of_string "H"
   | Name id   -> id;;
-let name_of_string str = Name (Id.of_string str)
-let string_of_name nme = Id.to_string (id_of_name nme)
+let name_of_string = Id.of_string %> Name.mk_name
+let string_of_name = id_of_name %> Id.to_string
 
 (** [isVarf f x] returns [true] if term [x] is of the form [(Var f)]. *)
 let isVarf f x =
@@ -73,13 +75,13 @@ let ident_global_exist id =
     let ans = CRef (Libnames.Ident (Loc.ghost,id), None) in
     let _ = ignore (Constrintern.intern_constr (Global.env()) ans) in
     true
-  with e when Errors.noncritical e -> false
+  with e when CErrors.noncritical e -> false
 
 (** [next_ident_fresh id] returns a fresh identifier (ie not linked in
     global env) with base [id]. *)
 let next_ident_fresh (id:Id.t) =
     let res = ref id in
-    while ident_global_exist !res do res := Nameops.lift_subscript !res done;
+    while ident_global_exist !res do res := Nameops.increment_subscript !res done;
     !res
 
 
@@ -137,7 +139,7 @@ let showind (id:Id.t) =
   let mib1,ib1 = Inductive.lookup_mind_specif (Global.env()) (fst ind1) in
   List.iter (fun decl ->
     print_string (string_of_name (Context.Rel.Declaration.get_name decl) ^ ":");
-    prconstr (get_type decl); print_string "\n")
+    prconstr (RelDecl.get_type decl); print_string "\n")
     ib1.mind_arity_ctxt;
     Printf.printf "arity :"; prconstr (Inductiveops.type_of_inductive (Global.env ()) ind1);
   Array.iteri
@@ -460,12 +462,12 @@ let shift_linked_params mib1 mib2 (lnk1:linked_var array) (lnk2:linked_var array
   let recprms2,otherprms2,args2,funresprms2 = bldprms (List.rev oib2.mind_arity_ctxt) mlnk2 in
   let _ = prstr "\notherprms1:\n" in
   let _ =
-    List.iter (fun decl -> prstr (string_of_name (get_name decl) ^ " : ");
-			   prconstr (get_type decl); prstr "\n")
+    List.iter (fun decl -> prstr (string_of_name (RelDecl.get_name decl) ^ " : ");
+			   prconstr (RelDecl.get_type decl); prstr "\n")
     otherprms1 in
   let _ = prstr "\notherprms2:\n" in
   let _ =
-    List.iter (fun decl -> prstr (string_of_name (get_name decl) ^ " : "); prconstr (get_type decl); prstr "\n")
+    List.iter (fun decl -> prstr (string_of_name (RelDecl.get_name decl) ^ " : "); prconstr (RelDecl.get_type decl); prstr "\n")
     otherprms2 in
   {
     ident=id;
@@ -785,10 +787,10 @@ let merge_inductive_body (shift:merge_infos) avoid (oib1:one_inductive_body)
 
   let params1 =
     try fst (glob_decompose_prod_n shift.nrecprms1 (List.hd lcstr1))
-    with e when Errors.noncritical e -> [] in
+    with e when CErrors.noncritical e -> [] in
   let params2 =
     try fst (glob_decompose_prod_n shift.nrecprms2 (List.hd lcstr2))
-    with e when Errors.noncritical e -> [] in
+    with e when CErrors.noncritical e -> [] in
 
   let lcstr1 = List.combine (Array.to_list oib1.mind_consnames) lcstr1 in
   let lcstr2 = List.combine (Array.to_list oib2.mind_consnames) lcstr2 in
@@ -827,7 +829,7 @@ let merge_rec_params_and_arity prms1 prms2 shift (concl:constr) =
     List.fold_left
       (fun (acc,env) decl ->
         let nm = Context.Rel.Declaration.get_name decl in
-        let c = get_type decl in
+        let c = RelDecl.get_type decl in
         let typ = Constrextern.extern_constr false env Evd.empty c in
         let newenv = Environ.push_rel (LocalAssum (nm,c)) env in
         CProdN (Loc.ghost, [[(Loc.ghost,nm)],Constrexpr_ops.default_binder_kind,typ] , acc) , newenv)
@@ -901,7 +903,7 @@ let find_Function_infos_safe (id:Id.t): Indfun_common.function_info =
       locate_constant f_ref in
     try find_Function_infos (kn_of_id id)
     with Not_found ->
-      errorlabstrm "indfun" (Nameops.pr_id id ++ str " has no functional scheme")
+      user_err ~hdr:"indfun" (Nameops.pr_id id ++ str " has no functional scheme")
 
 (** [merge id1 id2 args1 args2 id] builds and declares a new inductive
     type called [id], representing the merged graphs of both graphs
diff --git a/plugins/funind/recdef.ml b/plugins/funind/recdef.ml
index 80866e8b8..e00fa528a 100644
--- a/plugins/funind/recdef.ml
+++ b/plugins/funind/recdef.ml
@@ -16,7 +16,7 @@ open Names
 open Libnames
 open Globnames
 open Nameops
-open Errors
+open CErrors
 open Util
 open Tacticals
 open Tacmach
@@ -78,8 +78,10 @@ let def_of_const t =
 
 let type_of_const t =
    match (kind_of_term t) with
-    Const sp -> Typeops.type_of_constant (Global.env()) sp
-    |_ -> assert false
+   | Const sp ->
+      (* FIXME discarding universe constraints *)
+      Typeops.type_of_constant_in (Global.env()) sp
+   |_ -> assert false
 
 let constr_of_global x = 
   fst (Universes.unsafe_constr_of_global x)
@@ -92,15 +94,15 @@ let const_of_ref = function
 
 
 let nf_zeta env =
-  Reductionops.clos_norm_flags  (Closure.RedFlags.mkflags [Closure.RedFlags.fZETA])
+  Reductionops.clos_norm_flags  (CClosure.RedFlags.mkflags [CClosure.RedFlags.fZETA])
     env
     Evd.empty
 
 
 let nf_betaiotazeta = (* Reductionops.local_strong Reductionops.whd_betaiotazeta  *)
   let clos_norm_flags flgs env sigma t =
-    Closure.norm_val (Closure.create_clos_infos flgs env) (Closure.inject (Reductionops.nf_evar sigma t)) in
-  clos_norm_flags Closure.betaiotazeta  Environ.empty_env Evd.empty
+    CClosure.norm_val (CClosure.create_clos_infos flgs env) (CClosure.inject (Reductionops.nf_evar sigma t)) in
+  clos_norm_flags CClosure.betaiotazeta  Environ.empty_env Evd.empty
 
 
 
@@ -161,7 +163,7 @@ let rec n_x_id ids n =
 let simpl_iter clause =
   reduce
     (Lazy
-       {rBeta=true;rIota=true;rZeta= true; rDelta=false;
+       {rBeta=true;rMatch=true;rFix=true;rCofix=true;rZeta=true;rDelta=false;
         rConst = [ EvalConstRef (const_of_ref (delayed_force iter_ref))]})
     clause
 
@@ -214,7 +216,7 @@ let print_debug_queue b e =
     begin
       let lmsg,goal = Stack.pop debug_queue in 
       if b then 
-	Feedback.msg_debug (hov 1 (lmsg ++ (str " raised exception " ++ Errors.print e) ++ str " on goal" ++ fnl() ++ goal))
+	Feedback.msg_debug (hov 1 (lmsg ++ (str " raised exception " ++ CErrors.print e) ++ str " on goal" ++ fnl() ++ goal))
       else
 	begin
 	  Feedback.msg_debug (hov 1 (str " from " ++ lmsg ++ str " on goal"++fnl() ++ goal));
@@ -238,9 +240,9 @@ let do_observe_tac s tac g =
     ignore(Stack.pop debug_queue);
     v
   with reraise ->
-    let reraise = Errors.push reraise in
+    let reraise = CErrors.push reraise in
     if not (Stack.is_empty debug_queue)
-    then print_debug_queue true (fst (Cerrors.process_vernac_interp_error reraise));
+    then print_debug_queue true (fst (ExplainErr.process_vernac_interp_error reraise));
     iraise reraise
 
 let observe_tac s tac g =
@@ -307,7 +309,7 @@ let check_not_nested forbidden e =
       | Rel _ -> ()
       | Var x ->
         if Id.List.mem x forbidden
-        then errorlabstrm "Recdef.check_not_nested"
+        then user_err ~hdr:"Recdef.check_not_nested"
                (str "check_not_nested: failure " ++ pr_id x)
       | Meta _ | Evar _ | Sort _ -> ()
       | Cast(e,_,t) -> check_not_nested e;check_not_nested t
@@ -327,7 +329,7 @@ let check_not_nested forbidden e =
   try 
     check_not_nested e 
   with UserError(_,p) -> 
-    errorlabstrm "_" (str "on expr : " ++ Printer.pr_lconstr e ++ str " " ++ p)
+    user_err ~hdr:"_" (str "on expr : " ++ Printer.pr_lconstr e ++ str " " ++ p)
 
 (* ['a info] contains the local information for traveling *)
 type 'a infos = 
@@ -377,7 +379,7 @@ type journey_info =
 let rec add_vars forbidden e = 
   match kind_of_term e with 
     | Var x -> x::forbidden 
-    | _ -> fold_constr add_vars forbidden e 
+    | _ -> Term.fold_constr add_vars forbidden e
 
 
 let treat_case forbid_new_ids to_intros finalize_tac nb_lam e infos : tactic = 
@@ -441,16 +443,16 @@ let rec travel_aux jinfo continuation_tac (expr_info:constr infos) =
 	try
 	  check_not_nested (expr_info.f_id::expr_info.forbidden_ids) expr_info.info;
 	  jinfo.otherS () expr_info continuation_tac expr_info
-	with e when Errors.noncritical e ->
-	  errorlabstrm "Recdef.travel" (str "the term " ++ Printer.pr_lconstr expr_info.info ++ str " can not contain a recursive call to " ++ pr_id expr_info.f_id)
+	with e when CErrors.noncritical e ->
+	  user_err ~hdr:"Recdef.travel" (str "the term " ++ Printer.pr_lconstr expr_info.info ++ str " can not contain a recursive call to " ++ pr_id expr_info.f_id)
       end
     | Lambda(n,t,b) -> 
       begin
 	try
 	  check_not_nested (expr_info.f_id::expr_info.forbidden_ids) expr_info.info;
 	  jinfo.otherS () expr_info continuation_tac expr_info
-	with e when Errors.noncritical e ->
-	  errorlabstrm "Recdef.travel" (str "the term " ++ Printer.pr_lconstr expr_info.info ++ str " can not contain a recursive call to " ++ pr_id expr_info.f_id)
+	with e when CErrors.noncritical e ->
+	  user_err ~hdr:"Recdef.travel" (str "the term " ++ Printer.pr_lconstr expr_info.info ++ str " can not contain a recursive call to " ++ pr_id expr_info.f_id)
       end
     | Case(ci,t,a,l) -> 
       begin
@@ -478,7 +480,7 @@ let rec travel_aux jinfo continuation_tac (expr_info:constr infos) =
 	      jinfo.apP (f,args) expr_info continuation_tac in 
 	    travel_args jinfo
 	      expr_info.is_main_branch new_continuation_tac new_infos
-	  | Case _ ->  errorlabstrm "Recdef.travel" (str "the term " ++ Printer.pr_lconstr expr_info.info ++ str " can not contain an applied match (See Limitation in Section 2.3 of refman)")
+	  | Case _ ->  user_err ~hdr:"Recdef.travel" (str "the term " ++ Printer.pr_lconstr expr_info.info ++ str " can not contain an applied match (See Limitation in Section 2.3 of refman)")
 	  | _ -> anomaly (Pp.str "travel_aux : unexpected "++ Printer.pr_lconstr expr_info.info)
       end
     | Cast(t,_,_) -> travel jinfo continuation_tac {expr_info with info=t}
@@ -645,7 +647,7 @@ let terminate_letin (na,b,t,e) expr_info continuation_tac info =
       try 
 	check_not_nested (expr_info.f_id::expr_info.forbidden_ids) b;
 	true
-      with e when Errors.noncritical e -> false
+      with e when CErrors.noncritical e -> false
     in
     if forbid 
     then 
@@ -704,7 +706,7 @@ let terminate_case next_step (ci,a,t,l) expr_info continuation_tac infos g =
     try
       check_not_nested (expr_info.f_id::expr_info.forbidden_ids) a;
       false
-    with e when Errors.noncritical e ->
+    with e when CErrors.noncritical e ->
       true
   in
   let a' = infos.info in
@@ -723,8 +725,8 @@ let terminate_case next_step (ci,a,t,l) expr_info continuation_tac infos g =
 	 (List.map_i (fun i e -> observe_tac (str "do treat case") (treat_case f_is_present to_thin_intro (next_step continuation_tac) ci.ci_cstr_ndecls.(i) e new_info)) 0 (Array.to_list l)
 	 ))
     with 
-      | UserError("Refiner.thensn_tac3",_) 
-      | UserError("Refiner.tclFAIL_s",_) ->
+      | UserError(Some "Refiner.thensn_tac3",_) 
+      | UserError(Some "Refiner.tclFAIL_s",_) ->
 	(observe_tac (str "is computable " ++ Printer.pr_lconstr new_info.info) (next_step continuation_tac {new_info with info = nf_betaiotazeta new_info.info} )
 	))
     g
@@ -1281,12 +1283,12 @@ let open_new_goal build_proof sigma using_lemmas ref_ goal_name (gls_type,decomp
     | Some s -> s
     | None   ->
 	try add_suffix current_proof_name "_subproof"
-	with e when Errors.noncritical e ->
+	with e when CErrors.noncritical e ->
           anomaly (Pp.str "open_new_goal with an unamed theorem")
   in
   let na = next_global_ident_away name [] in
   if Termops.occur_existential gls_type then
-    Errors.error "\"abstract\" cannot handle existentials";
+    CErrors.error "\"abstract\" cannot handle existentials";
   let hook _ _ =
     let opacity =
       let na_ref = Libnames.Ident (Loc.ghost,na) in
@@ -1422,7 +1424,7 @@ let start_equation (f:global_reference) (term_f:global_reference)
   (cont_tactic:Id.t list -> tactic) g =
   let ids = pf_ids_of_hyps g in
   let terminate_constr = constr_of_global term_f in
-  let nargs = nb_prod (fst (type_of_const terminate_constr)) (*FIXME*) in
+  let nargs = nb_prod (type_of_const terminate_constr) in
   let x = n_x_id ids nargs in
   observe_tac (str "start_equation") (observe_tclTHENLIST (str "start_equation") [
     h_intros x;
@@ -1516,29 +1518,31 @@ let recursive_definition is_mes function_name rec_impls type_of_f r rec_arg_num
   let functional_id =  add_suffix function_name "_F" in
   let term_id = add_suffix function_name "_terminate" in
   let functional_ref = declare_fun functional_id (IsDefinition Decl_kinds.Definition) ~ctx:(snd (Evd.universe_context evm)) res in
+  (* Refresh the global universes, now including those of _F *)
+  let evm = Evd.from_env (Global.env ()) in
   let env_with_pre_rec_args = push_rel_context(List.map (function (x,t) -> LocalAssum (x,t)) pre_rec_args) env in
-  let relation =
-    fst (*FIXME*)(interp_constr
-      env_with_pre_rec_args
-      (Evd.from_env env_with_pre_rec_args)
-      r)
+  let relation, evuctx =
+    interp_constr env_with_pre_rec_args evm r
   in
+  let evm = Evd.from_ctx evuctx in
   let tcc_lemma_name = add_suffix function_name "_tcc" 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 (qualid_of_ident term_id) in
     let f_ref = declare_f function_name (IsProof Lemma) arg_types term_ref in
-    let _ = Table.extraction_inline true [Ident (Loc.ghost,term_id)] in 
+    let _ = Extraction_plugin.Table.extraction_inline true [Ident (Loc.ghost,term_id)] in
     (*     message "start second proof"; *)
     let stop = 
       try com_eqn (List.length res_vars) equation_id functional_ref f_ref term_ref (subst_var function_name equation_lemma_type);
 	  false
-      with e when Errors.noncritical e ->
+      with e when CErrors.noncritical e ->
 	begin
 	  if do_observe ()
-	  then Feedback.msg_debug (str "Cannot create equation Lemma " ++ Errors.print e)
-	  else anomaly (Pp.str "Cannot create equation Lemma")
+	  then Feedback.msg_debug (str "Cannot create equation Lemma " ++ CErrors.print e)
+	  else CErrors.user_err ~hdr:"Cannot create equation Lemma"
+               (str "Cannot create equation lemma." ++ spc () ++ 
+                str "This may be because the function is nested-recursive.")
 	  ;
 	  true
 	end
diff --git a/plugins/funind/recdef_plugin.mllib b/plugins/funind/recdef_plugin.mlpack
index ec1f5436c..2b443f2a1 100644
--- a/plugins/funind/recdef_plugin.mllib
+++ b/plugins/funind/recdef_plugin.mlpack
@@ -8,4 +8,3 @@ Invfun
 Indfun
 Merge
 G_indfun
-Recdef_plugin_mod
diff --git a/plugins/micromega/Env.v b/plugins/micromega/Env.v
index a19e9df90..7e3ef8929 100644
--- a/plugins/micromega/Env.v
+++ b/plugins/micromega/Env.v
@@ -93,7 +93,7 @@ End S.
 Ltac jump_simpl :=
   repeat
     match goal with
-      | |- appcontext [jump xH] => rewrite (jump_simpl xH)
-      | |- appcontext [jump (xO ?p)] => rewrite (jump_simpl (xO p))
-      | |- appcontext [jump (xI ?p)] => rewrite (jump_simpl (xI p))
+      | |- context [jump xH] => rewrite (jump_simpl xH)
+      | |- context [jump (xO ?p)] => rewrite (jump_simpl (xO p))
+      | |- context [jump (xI ?p)] => rewrite (jump_simpl (xI p))
     end.
diff --git a/plugins/micromega/EnvRing.v b/plugins/micromega/EnvRing.v
index fd4bb248b..904ee4dac 100644
--- a/plugins/micromega/EnvRing.v
+++ b/plugins/micromega/EnvRing.v
@@ -914,7 +914,7 @@ Qed.
  revert P1. induction LM1 as [|(M2,P2') LM2 IH]; simpl; intros.
  - discriminate.
  - assert (H':=PNSubst_ok n P3 M2 P2'). destruct PNSubst.
-   * injection H; intros <-. rewrite <- PSubstL1_ok; intuition.
+   * injection H as <-. rewrite <- PSubstL1_ok; intuition.
    * now apply IH.
  Qed.
 
diff --git a/plugins/micromega/Lia.v b/plugins/micromega/Lia.v
index 52bf5ed3d..47b6f7c7f 100644
--- a/plugins/micromega/Lia.v
+++ b/plugins/micromega/Lia.v
@@ -8,7 +8,7 @@
 (*                                                                      *)
 (* Micromega: A reflexive tactic using the Positivstellensatz           *)
 (*                                                                      *)
-(*  Frédéric Besson (Irisa/Inria)      2013                             *)
+(*  Frédéric Besson (Irisa/Inria)      2013-2016                        *)
 (*                                                                      *)
 (************************************************************************)
 
@@ -19,24 +19,24 @@ Require Import VarMap.
 Require Coq.micromega.Tauto.
 Declare ML Module "micromega_plugin".
 
+
 Ltac preprocess :=
   zify ; unfold Z.succ in * ; unfold Z.pred in *.
 
-Ltac lia :=
-  preprocess;
-  xlia ;
-  abstract (
-      intros __wit __varmap __ff ;
-      change (Tauto.eval_f (Zeval_formula (@find Z Z0 __varmap)) __ff) ;
-      apply (ZTautoChecker_sound __ff __wit); vm_cast_no_check (eq_refl true)).
-
-Ltac nia :=
-  preprocess;
-  xnlia ;
-  abstract (
-      intros __wit __varmap __ff ;
-      change (Tauto.eval_f (Zeval_formula (@find Z Z0 __varmap)) __ff) ;
-      apply (ZTautoChecker_sound __ff __wit); vm_cast_no_check (eq_refl true)).
+Ltac zchange := 
+  intros __wit __varmap __ff ;
+  change (Tauto.eval_f (Zeval_formula (@find Z Z0 __varmap)) __ff) ;
+  apply (ZTautoChecker_sound __ff __wit).
+
+Ltac zchecker_no_abstract := zchange ; vm_compute ; reflexivity.
+
+Ltac zchecker_abstract := zchange ; vm_cast_no_check (eq_refl true).
+
+Ltac zchecker := zchecker_no_abstract.
+
+Ltac lia := preprocess; xlia zchecker.
+               
+Ltac nia := preprocess; xnlia zchecker.
 
 
 (* Local Variables: *)
diff --git a/plugins/micromega/Lqa.v b/plugins/micromega/Lqa.v
new file mode 100644
index 000000000..acd2751a0
--- /dev/null
+++ b/plugins/micromega/Lqa.v
@@ -0,0 +1,51 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+(*                                                                      *)
+(* Micromega: A reflexive tactic using the Positivstellensatz           *)
+(*                                                                      *)
+(*  Frédéric Besson (Irisa/Inria)      2016                             *)
+(*                                                                      *)
+(************************************************************************)
+
+Require Import QMicromega.
+Require Import QArith.
+Require Import RingMicromega.
+Require Import VarMap.
+Require Coq.micromega.Tauto.
+Declare ML Module "micromega_plugin".
+
+Ltac rchange := 
+  intros __wit __varmap __ff ;
+  change (Tauto.eval_f (Qeval_formula (@find Q 0%Q __varmap)) __ff) ;
+  apply (QTautoChecker_sound __ff __wit).
+
+Ltac rchecker_no_abstract := rchange ; vm_compute ; reflexivity.
+Ltac rchecker_abstract   := rchange ; vm_cast_no_check (eq_refl true).
+
+Ltac rchecker := rchecker_no_abstract.
+
+(** Here, lra stands for linear rational arithmetic *)
+Ltac lra := lra_Q  rchecker.
+
+(** Here, nra stands for non-linear rational arithmetic *)
+Ltac nra := xnqa  rchecker.
+
+Ltac xpsatz dom d :=
+  let tac := lazymatch dom with
+  | Q =>
+    ((sos_Q rchecker) || (psatz_Q d rchecker))
+  | _ => fail "Unsupported domain"
+  end in tac.
+
+Tactic Notation "psatz" constr(dom) int_or_var(n) := xpsatz dom n.
+Tactic Notation "psatz" constr(dom) := xpsatz dom ltac:(-1).
+
+
+(* Local Variables: *)
+(* coding: utf-8 *)
+(* End: *)
diff --git a/plugins/micromega/Lra.v b/plugins/micromega/Lra.v
new file mode 100644
index 000000000..5b97d8ed3
--- /dev/null
+++ b/plugins/micromega/Lra.v
@@ -0,0 +1,52 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+(*                                                                      *)
+(* Micromega: A reflexive tactic using the Positivstellensatz           *)
+(*                                                                      *)
+(*  Frédéric Besson (Irisa/Inria)      2016                             *)
+(*                                                                      *)
+(************************************************************************)
+
+Require Import RMicromega.
+Require Import QMicromega.
+Require Import Rdefinitions.
+Require Import RingMicromega.
+Require Import VarMap.
+Require Coq.micromega.Tauto.
+Declare ML Module "micromega_plugin".
+
+Ltac rchange := 
+  intros __wit __varmap __ff ;
+  change (Tauto.eval_f (Reval_formula (@find R 0%R __varmap)) __ff) ;
+  apply (RTautoChecker_sound __ff __wit).
+
+Ltac rchecker_no_abstract := rchange ; vm_compute ; reflexivity.
+Ltac rchecker_abstract   := rchange ; vm_cast_no_check (eq_refl true).
+
+Ltac rchecker := rchecker_no_abstract.
+
+(** Here, lra stands for linear real arithmetic *)
+Ltac lra := unfold Rdiv in * ;   lra_R  rchecker.
+
+(** Here, nra stands for non-linear real arithmetic *)
+Ltac nra := unfold Rdiv in * ; xnra  rchecker.
+
+Ltac xpsatz dom d :=
+  let tac := lazymatch dom with
+  | R =>
+    (sos_R rchecker) || (psatz_R d rchecker)
+  | _ => fail "Unsupported domain"
+ end in tac.
+
+Tactic Notation "psatz" constr(dom) int_or_var(n) := xpsatz dom n.
+Tactic Notation "psatz" constr(dom) := xpsatz dom ltac:(-1).
+
+
+(* Local Variables: *)
+(* coding: utf-8 *)
+(* End: *)
diff --git a/plugins/micromega/MExtraction.v b/plugins/micromega/MExtraction.v
index 0a41af454..d28bb8286 100644
--- a/plugins/micromega/MExtraction.v
+++ b/plugins/micromega/MExtraction.v
@@ -50,7 +50,7 @@ Extract Constant Rinv   => "fun x -> 1 / x".
 
 Extraction "micromega.ml"
   List.map simpl_cone (*map_cone  indexes*)
-  denorm Qpower
+  denorm Qpower vm_add
   n_of_Z N.of_nat ZTautoChecker ZWeakChecker QTautoChecker RTautoChecker find.
 
 
diff --git a/plugins/micromega/Psatz.v b/plugins/micromega/Psatz.v
index fafd8a5f2..8acf0ff88 100644
--- a/plugins/micromega/Psatz.v
+++ b/plugins/micromega/Psatz.v
@@ -8,7 +8,7 @@
 (*                                                                      *)
 (* Micromega: A reflexive tactic using the Positivstellensatz           *)
 (*                                                                      *)
-(*  Frédéric Besson (Irisa/Inria) 2006-2008                             *)
+(*  Frédéric Besson (Irisa/Inria) 2006-2016                             *)
 (*                                                                      *)
 (************************************************************************)
 
@@ -21,50 +21,24 @@ Require Import Rdefinitions.
 Require Import RingMicromega.
 Require Import VarMap.
 Require Coq.micromega.Tauto.
-Declare ML Module "micromega_plugin".
+Require Lia.
+Require Lra.
+Require Lqa.
 
-Ltac preprocess := 
-    zify ; unfold Z.succ in * ; unfold Z.pred in *.
+Declare ML Module "micromega_plugin".
 
-Ltac lia :=
-  preprocess;
-  xlia ;
-  abstract (
-  intros __wit __varmap __ff ;
-    change (Tauto.eval_f (Zeval_formula (@find Z Z0 __varmap)) __ff) ;
-      apply (ZTautoChecker_sound __ff __wit); vm_cast_no_check (eq_refl true)).
+Ltac lia := Lia.lia.
 
-Ltac nia :=
-  preprocess;
-  xnlia ;
-  abstract (
-  intros __wit __varmap __ff ;
-    change (Tauto.eval_f (Zeval_formula (@find Z Z0 __varmap)) __ff) ;
-      apply (ZTautoChecker_sound __ff __wit); vm_cast_no_check (eq_refl true)).
+Ltac nia := Lia.nia.
 
 
 Ltac xpsatz dom d :=
   let tac := lazymatch dom with
   | Z =>
-    (sos_Z || psatz_Z d) ;
-      abstract(
-    intros __wit __varmap __ff ;
-    change (Tauto.eval_f (Zeval_formula (@find Z Z0 __varmap)) __ff) ;
-    apply (ZTautoChecker_sound __ff __wit); vm_cast_no_check (eq_refl true))
+    (sos_Z Lia.zchecker) || (psatz_Z d  Lia.zchecker)
   | R =>
-    (sos_R || psatz_R d) ;
-    (* If csdp is not installed, the previous step might not produce any
-    progress: the rest of the tactical will then fail. Hence the 'try'. *)
-    try (abstract(intros __wit __varmap __ff ;
-        change (Tauto.eval_f (Reval_formula (@find R 0%R __varmap)) __ff) ;
-        apply (RTautoChecker_sound __ff __wit); vm_cast_no_check (eq_refl true)))
-  | Q =>
-    (sos_Q || psatz_Q d) ;
-    (* If csdp is not installed, the previous step might not produce any
-    progress: the rest of the tactical will then fail. Hence the 'try'. *)
-    try  (abstract(intros __wit __varmap __ff ;
-        change (Tauto.eval_f (Qeval_formula (@find Q 0%Q __varmap)) __ff) ;
-        apply (QTautoChecker_sound __ff __wit); vm_cast_no_check (eq_refl true)))
+    (sos_R Lra.rchecker) || (psatz_R d Lra.rchecker)
+  | Q => (sos_Q Lqa.rchecker) || (psatz_Q d Lqa.rchecker) 
   | _ => fail "Unsupported domain"
   end in tac.
 
@@ -73,22 +47,9 @@ Tactic Notation "psatz" constr(dom) := xpsatz dom ltac:(-1).
 
 Ltac psatzl dom :=
   let tac := lazymatch dom with
-  | Z => lia
-  | Q =>
-    psatzl_Q ;
-    (* If csdp is not installed, the previous step might not produce any
-    progress: the rest of the tactical will then fail. Hence the 'try'. *)
-    try (abstract(intros __wit __varmap __ff ;
-        change (Tauto.eval_f (Qeval_formula (@find Q 0%Q __varmap)) __ff) ;
-        apply (QTautoChecker_sound __ff __wit); vm_cast_no_check (eq_refl true)))
-  | R =>
-    unfold Rdiv in * ; 
-    psatzl_R ;
-    (* If csdp is not installed, the previous step might not produce any
-    progress: the rest of the tactical will then fail. Hence the 'try'. *)
-    try abstract((intros __wit __varmap __ff ;
-        change (Tauto.eval_f (Reval_formula (@find R 0%R __varmap)) __ff) ;
-        apply (RTautoChecker_sound __ff __wit); vm_cast_no_check (eq_refl true)))
+  | Z => Lia.lia
+  | Q => Lqa.lra
+  | R => Lra.lra
   | _ => fail "Unsupported domain"
   end in tac.
 
@@ -97,13 +58,7 @@ Ltac lra :=
   first [ psatzl R | psatzl Q ].
 
 Ltac nra := 
-  unfold Rdiv in * ; 
-  xnra ;     
-  abstract 
-    (intros __wit __varmap __ff ;
-     change (Tauto.eval_f (Reval_formula (@find R 0%R __varmap)) __ff) ;
-     apply (RTautoChecker_sound __ff __wit); vm_compute ; reflexivity).
-                                                                       
+  first [ Lra.nra | Lqa.nra ].  
 
 
 (* Local Variables: *)
diff --git a/plugins/micromega/VarMap.v b/plugins/micromega/VarMap.v
index 4981ddb30..2d2c0bc77 100644
--- a/plugins/micromega/VarMap.v
+++ b/plugins/micromega/VarMap.v
@@ -1,7 +1,7 @@
 (* -*- coding: utf-8 -*- *)
 (************************************************************************)
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015     *)
 (*   \VV/  **************************************************************)
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
@@ -26,6 +26,7 @@ Set Implicit Arguments.
  *)
 
 Section MakeVarMap.
+  
   Variable A : Type.
   Variable default : A.
 
@@ -46,5 +47,29 @@ Section MakeVarMap.
     end.
 
 
-End MakeVarMap.
+  Fixpoint singleton (x:positive) (v : A) : t :=
+    match x with
+    | xH => Leaf v
+    | xO p => Node (singleton p v) default Empty
+    | xI p => Node Empty default (singleton p v)
+    end.
+  
+  Fixpoint vm_add (x: positive) (v : A) (m : t) {struct m} : t :=
+    match m with
+    | Empty   => singleton x v
+    | Leaf vl =>
+      match x with
+      | xH => Leaf v
+      | xO p => Node (singleton p v) vl Empty
+      | xI p => Node Empty vl (singleton p v)
+      end
+    | Node l o r => 
+      match x with
+      | xH => Node l v r
+      | xI p => Node l o (vm_add p v r)
+      | xO p => Node (vm_add p v l) o r
+      end
+    end.
 
+  
+End MakeVarMap.  
diff --git a/plugins/micromega/certificate.ml b/plugins/micromega/certificate.ml
index 1561c811c..459c72f9f 100644
--- a/plugins/micromega/certificate.ml
+++ b/plugins/micromega/certificate.ml
@@ -331,7 +331,7 @@ let dual_raw_certificate (l:  (Poly.t * Mc.op1) list) =
   | Inr _ -> None
   | Inl cert ->  Some (rats_to_ints (Vect.to_list cert)) 
   (* should not use rats_to_ints *)
- with x when Errors.noncritical x ->
+ with x when CErrors.noncritical x ->
   if debug
   then (Printf.printf "raw certificate %s" (Printexc.to_string x);
         flush stdout) ;
@@ -378,7 +378,7 @@ let linear_prover n_spec l  =
 
 let linear_prover n_spec l  =
  try linear_prover n_spec l
- with x when Errors.noncritical x ->
+ with x when CErrors.noncritical x ->
   (print_string (Printexc.to_string x); None)
 
 let compute_max_nb_cstr l d =
diff --git a/plugins/micromega/coq_micromega.ml b/plugins/micromega/coq_micromega.ml
index e4aa1448e..e4b58a56f 100644
--- a/plugins/micromega/coq_micromega.ml
+++ b/plugins/micromega/coq_micromega.ml
@@ -147,6 +147,17 @@ let rec map_atoms fct f =
     | N f -> N(map_atoms fct f)
     | I(f1,o,f2) -> I(map_atoms fct f1, o , map_atoms fct f2)
 
+let rec map_prop fct f =
+  match f with
+    | TT -> TT
+    | FF -> FF
+    | X x -> X (fct x)
+    | A (at,tg,cstr) -> A(at,tg,cstr)
+    | C (f1,f2) -> C(map_prop fct f1, map_prop fct f2)
+    | D (f1,f2) -> D(map_prop fct f1, map_prop fct f2)
+    | N f -> N(map_prop fct f)
+    | I(f1,o,f2) -> I(map_prop fct f1, o , map_prop fct f2)
+
 (**
   * Collect the identifiers of a (string of) implications. Implication labels
   * are inherited from Coq/CoC's higher order dependent type constructor (Pi).
@@ -292,7 +303,8 @@ let rec add_term  t0 = function
   *)
 
 module ISet = Set.Make(Int)
-
+module IMap = Map.Make(Int)
+  
 (**
   * Given a set of integers s=\{i0,...,iN\} and a list m, return the list of
   * elements of m that are at position i0,...,iN.
@@ -371,6 +383,8 @@ struct
   let coq_and = lazy (init_constant "and")
   let coq_or = lazy (init_constant "or")
   let coq_not = lazy (init_constant "not")
+  let coq_not_gl_ref = (Nametab.locate (  Libnames.qualid_of_string "Coq.Init.Logic.not"))
+
   let coq_iff = lazy (init_constant "iff")
   let coq_True = lazy (init_constant "True")
   let coq_False = lazy (init_constant "False")
@@ -947,8 +961,20 @@ struct
           let (env,n) = _add l ( n+1) v in
            (e::env,n) in
     let (env, n) =  _add env 1 v in
-     (env, CamlToCoq.idx n)
+     (env, CamlToCoq.positive n)
+
+   let get_rank env v = 
+
+     let rec _get_rank env n =
+       match env with
+       | [] -> raise (Invalid_argument "get_rank")
+      | e::l ->
+         if eq_constr e v
+         then n
+         else  _get_rank l (n+1)  in 
+     _get_rank env 1
 
+       
    let empty = []
 
    let elements env = env
@@ -998,7 +1024,7 @@ struct
                            let (expr,env) = parse_expr env args.(0) in
                            let power = (parse_exp expr args.(1)) in
                              (power  , env)
-			 with e when Errors.noncritical e ->
+			 with e when CErrors.noncritical e ->
                            (* if the exponent is a variable *)
                            let (env,n) = Env.compute_rank_add env term in (Mc.PEX n, env)
                        end
@@ -1170,36 +1196,35 @@ struct
       try
         let (at,env) = parse_atom env t gl in
         (A(at,tg,t), env,Tag.next tg)
-      with e when Errors.noncritical e -> (X(t),env,tg) in
+      with e when CErrors.noncritical e -> (X(t),env,tg) in
 
     let is_prop term =
-     let ty   = Typing.unsafe_type_of (Tacmach.pf_env gl) (Tacmach.project gl) term in
-     let sort = Typing.e_sort_of (Tacmach.pf_env gl) (ref (Tacmach.project gl)) ty in
+      let sort  = Retyping.get_sort_of (Tacmach.pf_env gl)  (Tacmach.project gl) term in 
      Term.is_prop_sort sort in
      
     let rec xparse_formula env tg term =
-     match kind_of_term term with
+      match kind_of_term term with
       | App(l,rst) ->
-          (match rst with
-           | [|a;b|] when eq_constr l (Lazy.force coq_and) ->
-               let f,env,tg = xparse_formula env tg a in
-               let g,env, tg = xparse_formula env tg b  in
-               mkformula_binary mkC term f g,env,tg
-           | [|a;b|] when eq_constr l (Lazy.force coq_or) ->
-               let f,env,tg = xparse_formula env tg a in
-               let g,env,tg  = xparse_formula env tg b in
-               mkformula_binary mkD term f g,env,tg
-           | [|a|] when eq_constr l (Lazy.force coq_not) ->
-               let (f,env,tg) = xparse_formula env tg a in (N(f), env,tg)
-           | [|a;b|] when eq_constr l (Lazy.force coq_iff) ->
-               let f,env,tg = xparse_formula env tg a in
-               let g,env,tg = xparse_formula env tg b in
-               mkformula_binary mkIff term f g,env,tg
-           | _ -> parse_atom env tg term)
-      | Prod(typ,a,b) when not (Termops.dependent (mkRel 1) b)->
+        (match rst with
+        | [|a;b|] when eq_constr l (Lazy.force coq_and) ->
+          let f,env,tg = xparse_formula env tg a in
+          let g,env, tg = xparse_formula env tg b  in
+          mkformula_binary mkC term f g,env,tg
+        | [|a;b|] when eq_constr l (Lazy.force coq_or) ->
+          let f,env,tg = xparse_formula env tg a in
+          let g,env,tg  = xparse_formula env tg b in
+          mkformula_binary mkD term f g,env,tg
+        | [|a|] when eq_constr l (Lazy.force coq_not) ->
+          let (f,env,tg) = xparse_formula env tg a in (N(f), env,tg)
+        | [|a;b|] when eq_constr l (Lazy.force coq_iff) ->
           let f,env,tg = xparse_formula env tg a in
           let g,env,tg = xparse_formula env tg b in
-          mkformula_binary mkI term f g,env,tg
+          mkformula_binary mkIff term f g,env,tg
+        | _ -> parse_atom env tg term)
+      | Prod(typ,a,b) when not (Termops.dependent (mkRel 1) b)->
+        let f,env,tg = xparse_formula env tg a in
+        let g,env,tg = xparse_formula env tg b in
+        mkformula_binary mkI term f g,env,tg
       | _ when eq_constr term (Lazy.force coq_True) -> (TT,env,tg)
       | _ when eq_constr term (Lazy.force coq_False) -> (FF,env,tg)
       | _ when is_prop term -> X(term),env,tg
@@ -1220,12 +1245,214 @@ struct
      | X(t) -> mkApp(Lazy.force coq_X,[|typ ; t|])  in
    xdump f
 
-  (**
-    * Given a conclusion and a list of affectations, rebuild a term prefixed by
-    * the appropriate letins.
-    * TODO: reverse the list of bindings!
-    *)
 
+  let prop_env_of_formula form =
+    let rec doit env = function
+      | TT | FF | A(_,_,_) -> env
+      | X t -> fst (Env.compute_rank_add env t)
+      | C(f1,f2) | D(f1,f2) | I(f1,_,f2) -> 
+        doit (doit env f1) f2
+      | N f -> doit env f in
+    
+    doit [] form
+
+  let var_env_of_formula form =
+
+    let rec vars_of_expr  = function
+      | Mc.PEX n -> ISet.singleton (CoqToCaml.positive n)
+      | Mc.PEc z -> ISet.empty
+      | Mc.PEadd(e1,e2) | Mc.PEmul(e1,e2) | Mc.PEsub(e1,e2) ->
+        ISet.union (vars_of_expr e1) (vars_of_expr e2)
+      | Mc.PEopp e | Mc.PEpow(e,_)-> vars_of_expr e
+    in
+    
+    let vars_of_atom  {Mc.flhs ; Mc.fop; Mc.frhs} =
+      ISet.union (vars_of_expr flhs) (vars_of_expr frhs) in
+      
+    let rec doit = function
+      |  TT | FF | X _ -> ISet.empty
+      | A (a,t,c) -> vars_of_atom a
+      | C(f1,f2) | D(f1,f2) |I (f1,_,f2) -> ISet.union (doit f1) (doit f2)
+      | N f -> doit f in
+
+    doit  form
+    
+
+
+      
+  type 'cst dump_expr =  (* 'cst is the type of the syntactic constants *)
+    {
+      interp_typ : constr; 
+      dump_cst : 'cst -> constr; 
+      dump_add : constr; 
+      dump_sub : constr;
+      dump_opp : constr;
+      dump_mul : constr;
+      dump_pow : constr;
+      dump_pow_arg : Mc.n -> constr;
+      dump_op  : (Mc.op2 * Term.constr) list
+    }
+
+let dump_zexpr = lazy
+  {
+    interp_typ = Lazy.force coq_Z;
+    dump_cst = dump_z;
+    dump_add = Lazy.force coq_Zplus;
+    dump_sub = Lazy.force coq_Zminus;
+    dump_opp = Lazy.force coq_Zopp;
+    dump_mul = Lazy.force coq_Zmult;
+    dump_pow = Lazy.force coq_Zpower;
+    dump_pow_arg = (fun n -> dump_z (CamlToCoq.z (CoqToCaml.n n)));
+    dump_op  = List.map (fun (x,y) -> (y,Lazy.force x)) zop_table
+  }
+
+let dump_qexpr = lazy
+  {
+    interp_typ = Lazy.force coq_Q;
+    dump_cst = dump_q;
+    dump_add = Lazy.force coq_Qplus;
+    dump_sub = Lazy.force coq_Qminus;
+    dump_opp = Lazy.force coq_Qopp;
+    dump_mul = Lazy.force coq_Qmult;
+    dump_pow = Lazy.force coq_Qpower;
+    dump_pow_arg = (fun n -> dump_z (CamlToCoq.z (CoqToCaml.n n)));
+    dump_op  = List.map (fun (x,y) -> (y,Lazy.force x)) qop_table      
+  }
+
+  let dump_positive_as_R p =
+  let mult = Lazy.force coq_Rmult in
+  let add  = Lazy.force coq_Rplus  in
+
+  let one  = Lazy.force coq_R1    in 
+  let mk_add x y  = mkApp(add,[|x;y|]) in
+  let mk_mult x y = mkApp(mult,[|x;y|]) in
+
+  let two  = mk_add one one in 
+
+  let rec dump_positive p = 
+      match p with
+      | Mc.XH   -> one
+      | Mc.XO p -> mk_mult two (dump_positive p)
+      | Mc.XI p -> mk_add one (mk_mult two (dump_positive p)) in
+
+  dump_positive p
+
+let dump_n_as_R n =
+  let z = CoqToCaml.n n in
+  if z = 0
+  then Lazy.force coq_R0
+  else dump_positive_as_R (CamlToCoq.positive z)
+    
+
+let rec dump_Rcst_as_R cst = 
+  match cst with
+  | Mc.C0 -> Lazy.force coq_R0 
+  | Mc.C1 ->  Lazy.force coq_R1
+  | Mc.CQ q ->  Term.mkApp(Lazy.force coq_IQR, [| dump_q q |])
+  | Mc.CZ z -> Term.mkApp(Lazy.force coq_IZR, [| dump_z z |])
+  | Mc.CPlus(x,y) -> Term.mkApp(Lazy.force coq_Rplus, [| dump_Rcst_as_R x ; dump_Rcst_as_R y |])
+  | Mc.CMinus(x,y) -> Term.mkApp(Lazy.force coq_Rminus, [| dump_Rcst_as_R x ; dump_Rcst_as_R y |])
+  | Mc.CMult(x,y) -> Term.mkApp(Lazy.force coq_Rmult, [| dump_Rcst_as_R x ; dump_Rcst_as_R y |])
+  | Mc.CInv t -> Term.mkApp(Lazy.force coq_Rinv, [| dump_Rcst_as_R t |])
+  | Mc.COpp t -> Term.mkApp(Lazy.force coq_Ropp, [| dump_Rcst_as_R t |])
+
+
+let dump_rexpr = lazy
+  {
+    interp_typ = Lazy.force coq_R;
+    dump_cst = dump_Rcst_as_R;
+    dump_add = Lazy.force coq_Rplus;
+    dump_sub = Lazy.force coq_Rminus;
+    dump_opp = Lazy.force coq_Ropp;
+    dump_mul = Lazy.force coq_Rmult;
+    dump_pow = Lazy.force coq_Rpower;
+    dump_pow_arg = (fun n -> dump_nat (CamlToCoq.nat (CoqToCaml.n n)));
+    dump_op  = List.map (fun (x,y) -> (y,Lazy.force x)) rop_table      
+  }
+
+
+    
+    
+(** [make_goal_of_formula depxr vars props form] where 
+     - vars is an environment for the arithmetic variables occuring in form
+     - props is an environment for the propositions occuring in form
+    @return a goal where all the variables and propositions of the formula are quantified
+
+*) 
+
+let rec make_goal_of_formula dexpr form =
+
+  let vars_idx =
+    List.mapi (fun i v -> (v, i+1))  (ISet.elements (var_env_of_formula form)) in
+
+  (*  List.iter (fun (v,i) -> Printf.fprintf stdout "var %i has index %i\n" v i) vars_idx ;*)
+  
+  let props     = prop_env_of_formula form in 
+
+  let vars_n  = List.map (fun (_,i) -> (Names.id_of_string (Printf.sprintf "__x%i" i)) , dexpr.interp_typ) vars_idx in 
+  let props_n = List.mapi (fun i _ -> (Names.id_of_string (Printf.sprintf "__p%i" (i+1))) , Term.mkProp) props in 
+
+  let var_name_pos = List.map2 (fun (idx,_) (id,_) -> id,idx) vars_idx vars_n in
+
+  let  dump_expr i e =
+    let rec dump_expr  = function
+    | Mc.PEX n -> mkRel (i+(List.assoc (CoqToCaml.positive n)  vars_idx))
+    | Mc.PEc z -> dexpr.dump_cst z
+    | Mc.PEadd(e1,e2) -> mkApp(dexpr.dump_add,
+                               [| dump_expr e1;dump_expr e2|])
+    | Mc.PEsub(e1,e2) -> mkApp(dexpr.dump_sub,
+                               [| dump_expr  e1;dump_expr  e2|])
+    | Mc.PEopp e -> mkApp(dexpr.dump_opp,
+                          [| dump_expr  e|])
+    | Mc.PEmul(e1,e2) ->  mkApp(dexpr.dump_mul,
+                                [| dump_expr  e1;dump_expr e2|])
+    | Mc.PEpow(e,n) ->  mkApp(dexpr.dump_pow,
+                              [| dump_expr  e; dexpr.dump_pow_arg  n|])
+    in dump_expr e in
+  
+  let mkop op e1 e2 =
+      try
+        Term.mkApp(List.assoc op dexpr.dump_op, [| e1; e2|])
+      with Not_found ->
+        Term.mkApp(Lazy.force coq_Eq,[|dexpr.interp_typ ; e1 ;e2|]) in
+    
+  let dump_cstr i { Mc.flhs ; Mc.fop ; Mc.frhs } =
+    mkop fop (dump_expr i flhs) (dump_expr i frhs) in
+  
+  let rec xdump pi xi f =
+    match f with
+    | TT  -> Lazy.force coq_True
+    | FF  -> Lazy.force coq_False
+    | C(x,y) -> mkApp(Lazy.force coq_and,[|xdump pi xi x ; xdump pi xi y|])
+    | D(x,y) -> mkApp(Lazy.force coq_or,[| xdump pi xi x ; xdump pi xi y|])
+    | I(x,_,y) -> mkArrow (xdump pi xi x) (xdump (pi+1) (xi+1) y)
+    | N(x) -> mkArrow (xdump pi xi x) (Lazy.force coq_False)
+    | A(x,_,_) -> dump_cstr xi x
+    | X(t) -> let idx = Env.get_rank props t in
+              mkRel (pi+idx) in 
+  
+  let nb_vars  = List.length vars_n  in
+  let nb_props = List.length props_n in 
+
+  (*  Printf.fprintf stdout "NBProps : %i\n" nb_props ;*)
+  
+  let subst_prop p =
+    let idx = Env.get_rank props p in
+    mkVar (Names.id_of_string (Printf.sprintf "__p%i"  idx)) in 
+
+  let form' = map_prop subst_prop   form in
+
+  (Term.prodn nb_props (List.map (fun (x,y) -> Names.Name x,y) props_n)
+     (Term.prodn nb_vars (List.map (fun (x,y) -> Names.Name x,y) vars_n)
+        (xdump (List.length vars_n) 0  form)),
+   List.rev props_n, List.rev var_name_pos,form')
+    
+  (**
+     * Given a conclusion and a list of affectations, rebuild a term prefixed by
+     * the appropriate letins.
+     * TODO: reverse the list of bindings!
+  *)
+    
   let set l concl =
    let rec xset acc = function
     | [] -> acc
@@ -1300,29 +1527,25 @@ let coq_Empty = lazy
  (Coqlib.gen_constant_in_modules "VarMap"
    [["Coq" ; "micromega" ;"VarMap"];["VarMap"]] "Empty")
 
-let btree_of_array typ a  =
- let size_of_a = Array.length a in
- let semi_size_of_a = size_of_a lsr 1 in
- let node = Lazy.force coq_Node
- and leaf = Lazy.force coq_Leaf
- and empty = Term.mkApp (Lazy.force coq_Empty, [| typ |]) in
- let rec aux n =
-  if n > size_of_a
-  then empty
-  else if  n > semi_size_of_a
-  then Term.mkApp (leaf, [| typ; a.(n-1) |])
-  else Term.mkApp (node, [| typ; aux (2*n); a.(n-1); aux (2*n+1) |])
- in
-  aux 1
-
-let btree_of_array typ a =
- try
-  btree_of_array typ a
- with x when Errors.noncritical x ->
-  failwith (Printf.sprintf "btree of array : %s" (Printexc.to_string x))
-
-let dump_varmap typ env =
- btree_of_array typ (Array.of_list env)
+let coq_VarMap = lazy
+  (Coqlib.gen_constant_in_modules "VarMap"
+     [["Coq" ; "micromega" ; "VarMap"] ; ["VarMap"]] "t")
+ 
+
+let rec dump_varmap typ m =
+  match m with
+  | Mc.Empty -> Term.mkApp(Lazy.force coq_Empty,[| typ |])
+  | Mc.Leaf v -> Term.mkApp(Lazy.force coq_Leaf,[| typ; v|])
+  | Mc.Node(l,o,r) ->
+    Term.mkApp (Lazy.force coq_Node, [| typ; dump_varmap typ l; o ; dump_varmap typ r |])
+
+
+let vm_of_list env =
+  match env with
+  | [] -> Mc.Empty
+  | (d,_)::_ -> 
+    List.fold_left (fun vm (c,i) ->
+      Mc.vm_add d (CamlToCoq.positive i) c vm) Mc.Empty env 
 
 
 let rec pp_varmap o vm =
@@ -1387,7 +1610,7 @@ let rec parse_hyps gl parse_arith env tg hyps =
       try
        let (c,env,tg) = parse_formula gl parse_arith env  tg t in
 	((i,c)::lhyps, env,tg)
-      with e when Errors.noncritical e -> (lhyps,env,tg)
+      with e when CErrors.noncritical e -> (lhyps,env,tg)
        (*(if debug then Printf.printf "parse_arith : %s\n" x);*)
 
 
@@ -1437,17 +1660,46 @@ let rcst_domain_spec  = lazy {
 
 open Proofview.Notations
 
- 
+(** Naive topological sort of constr according to the subterm-ordering *)
+
+(* An element is minimal x is minimal w.r.t y if 
+   x <= y or (x and y are incomparable) *)
+
+let is_min le x y =
+  if le x y then true
+  else    if le y x then false else true
+
+let is_minimal le l c = List.for_all (is_min le c) l
+    
+let find_rem p l =
+  let rec xfind_rem  acc l =
+    match l with
+    | [] -> (None, acc)
+    | x :: l -> if p x then (Some x, acc @ l)
+      else xfind_rem (x::acc) l in
+  xfind_rem [] l
+
+let find_minimal le l = find_rem (is_minimal le l) l
+  
+let rec mk_topo_order le l =
+  match find_minimal le l with
+  | (None , _) -> []
+  | (Some v,l') -> v ::  (mk_topo_order le l')
+
+    
+let topo_sort_constr l = mk_topo_order Termops.dependent l
+
+
 (**
   * Instanciate the current Coq goal with a Micromega formula, a varmap, and a
   * witness.
   *)
 
 let micromega_order_change spec cert cert_typ env ff  (*: unit Proofview.tactic*) = 
- let ids = Util.List.map_i (fun i _ -> (Names.Id.of_string ("__z"^(string_of_int i)))) 0 env in 
+ (* let ids = Util.List.map_i (fun i _ -> (Names.Id.of_string ("__v"^(string_of_int i)))) 0 env in *)
  let formula_typ = (Term.mkApp (Lazy.force coq_Cstr,[|spec.coeff|])) in
  let ff  = dump_formula formula_typ (dump_cstr spec.coeff spec.dump_coeff) ff in
- let vm = dump_varmap (spec.typ) env in
+ let vm = dump_varmap (spec.typ) (vm_of_list env) in
  (* todo : directly generate the proof term - or generalize before conversion? *)
   Proofview.Goal.nf_enter { enter = begin fun gl -> 
    let gl = Tacmach.New.of_old (fun x -> x) gl in
@@ -1457,15 +1709,10 @@ let micromega_order_change spec cert cert_typ env ff  (*: unit Proofview.tactic*
     (set
       [
        ("__ff", ff, Term.mkApp(Lazy.force coq_Formula, [|formula_typ |]));
-       ("__varmap", vm, Term.mkApp
-        (Coqlib.gen_constant_in_modules "VarMap"
-	[["Coq" ; "micromega" ; "VarMap"] ; ["VarMap"]] "t", [|spec.typ|])); 
+       ("__varmap", vm, Term.mkApp(Lazy.force coq_VarMap, [|spec.typ|]));
        ("__wit", cert, cert_typ)
       ]
       (Tacmach.pf_concl gl))
-   ;
-   Tactics.generalize env ;
-   Tacticals.New.tclTHENLIST (List.map (fun id ->  (Tactics.introduction id)) ids)
   ] 
   end }
 
@@ -1547,7 +1794,7 @@ let compact_proofs (cnf_ff: 'cst cnf) res (cnf_ff': 'cst cnf) =
           (pp_ml_list prover.pp_f) (List.map fst new_cl)   ;
           flush stdout
       end ; *)
-    let res = try prover.compact prf remap with x when Errors.noncritical x ->
+    let res = try prover.compact prf remap with x when CErrors.noncritical x ->
       if debug then Printf.fprintf stdout "Proof compaction %s" (Printexc.to_string x) ;
       (* This should not happen -- this is the recovery plan... *)
       match prover.prover (prover.get_option () ,List.map fst new_cl) with
@@ -1627,6 +1874,7 @@ let rec abstract_wrt_formula f1 f2 =
 
 exception CsdpNotFound
 
+  
 (**
   * This is the core of Micromega: apply the prover, analyze the result and
   * prune unused fomulas, and finally modify the proof state.
@@ -1711,7 +1959,7 @@ let micromega_gen
     (negate:'cst atom -> 'cst mc_cnf)
     (normalise:'cst atom -> 'cst mc_cnf)
     unsat deduce 
-    spec prover =
+    spec dumpexpr prover tac =
  Proofview.Goal.nf_enter { enter = begin fun gl -> 
     let gl = Tacmach.New.of_old (fun x -> x) gl in
     let concl = Tacmach.pf_concl gl in
@@ -1720,16 +1968,45 @@ let micromega_gen
      let (hyps,concl,env) = parse_goal gl parse_arith Env.empty hyps concl in
      let env = Env.elements env in
      let spec = Lazy.force spec in
+     let dumpexpr = Lazy.force dumpexpr in
      
      match micromega_tauto  negate normalise unsat deduce spec prover env hyps concl gl with
      | None -> Tacticals.New.tclFAIL 0 (Pp.str " Cannot find witness")
      | Some (ids,ff',res') -> 
-      (Tacticals.New.tclTHENLIST
-	[
-	 Tactics.generalize (List.map Term.mkVar ids) ;
-	 micromega_order_change  spec res' 
-	  (Term.mkApp(Lazy.force coq_list, [|spec.proof_typ|])) env ff'
-	])
+       let (arith_goal,props,vars,ff_arith) = make_goal_of_formula dumpexpr ff' in
+       let intro (id,_) = Tactics.introduction id  in 
+
+       let intro_vars = Tacticals.New.tclTHENLIST (List.map intro vars) in
+       let intro_props = Tacticals.New.tclTHENLIST (List.map intro props) in
+       let ipat_of_name id = Some (Loc.ghost, Misctypes.IntroNaming (Misctypes.IntroIdentifier id)) in
+       let goal_name = Tactics.fresh_id [] (Names.Id.of_string "__arith") gl in
+       let env' = List.map (fun (id,i) -> Term.mkVar id,i) vars in 
+
+       let tac_arith = Tacticals.New.tclTHENLIST [ intro_props ; intro_vars ; 
+                                                    micromega_order_change spec res'
+                                                      (Term.mkApp(Lazy.force coq_list, [|spec.proof_typ|])) env' ff_arith ] in
+
+       let goal_props = List.rev (prop_env_of_formula ff') in 
+
+       let goal_vars = List.map (fun (_,i) -> List.nth env (i-1)) vars in 
+       
+       let arith_args = goal_props @ goal_vars in
+
+       let kill_arith = 
+           Tacticals.New.tclTHEN
+             (Tactics.keep [])
+             ((*Tactics.tclABSTRACT  None*)
+                (Tacticals.New.tclTHEN tac_arith tac)) in 
+
+       Tacticals.New.tclTHENS
+         (Tactics.forward true (Some None) (ipat_of_name goal_name) arith_goal)
+         [
+           kill_arith;
+           (Tacticals.New.tclTHENLIST
+            [(Tactics.generalize (List.map Term.mkVar ids));
+             Tactics.exact_check (Term.applist (Term.mkVar goal_name, arith_args))
+            ] )
+         ]
     with
     | ParseError  -> Tacticals.New.tclFAIL 0 (Pp.str "Bad logical fragment")
     | Mfourier.TimeOut  -> Tacticals.New.tclFAIL 0 (Pp.str "Timeout")
@@ -1751,16 +2028,16 @@ let micromega_gen parse_arith
        
 
 let micromega_order_changer cert env ff  = 
- let ids = Util.List.map_i (fun i _ -> (Names.Id.of_string ("__z"^(string_of_int i)))) 0 env in 
- let coeff = Lazy.force coq_Rcst in
- let dump_coeff = dump_Rcst in
- let typ  = Lazy.force coq_R in
- let cert_typ = (Term.mkApp(Lazy.force coq_list, [|Lazy.force coq_QWitness |])) in
+  (*let ids = Util.List.map_i (fun i _ -> (Names.Id.of_string ("__v"^(string_of_int i)))) 0 env in *)
+  let coeff = Lazy.force coq_Rcst in
+  let dump_coeff = dump_Rcst in
+  let typ  = Lazy.force coq_R in
+  let cert_typ = (Term.mkApp(Lazy.force coq_list, [|Lazy.force coq_QWitness |])) in
  
- let formula_typ = (Term.mkApp (Lazy.force coq_Cstr,[| coeff|])) in
- let ff = dump_formula formula_typ (dump_cstr coeff dump_coeff) ff in
- let vm = dump_varmap (typ) env in
- Proofview.Goal.nf_enter { enter = begin fun gl -> 
+  let formula_typ = (Term.mkApp (Lazy.force coq_Cstr,[| coeff|])) in
+  let ff = dump_formula formula_typ (dump_cstr coeff dump_coeff) ff in
+  let vm = dump_varmap (typ) (vm_of_list env) in
+  Proofview.Goal.nf_enter { enter = begin fun gl -> 
     let gl = Tacmach.New.of_old (fun x -> x) gl in
     Tacticals.New.tclTHENLIST
      [
@@ -1774,13 +2051,11 @@ let micromega_order_changer cert env ff  =
          ("__wit", cert, cert_typ)
         ]
         (Tacmach.pf_concl gl)));
-      Tactics.generalize env ;
-      Tacticals.New.tclTHENLIST (List.map (fun id ->  (Tactics.introduction id)) ids)
+     (*      Tacticals.New.tclTHENLIST (List.map (fun id ->  (Tactics.introduction id)) ids)*)
      ]
   end }
 
-
-let micromega_genr prover =
+let micromega_genr prover tac =
   let parse_arith = parse_rarith in
   let negate = Mc.rnegate in
   let normalise = Mc.rnormalise in
@@ -1797,6 +2072,7 @@ let micromega_genr prover =
      let gl = Tacmach.New.of_old (fun x -> x) gl in
      let concl = Tacmach.pf_concl gl in
      let hyps  = Tacmach.pf_hyps_types gl in
+
      try
       let (hyps,concl,env) = parse_goal gl parse_arith Env.empty hyps concl in
        let env = Env.elements env in
@@ -1808,23 +2084,56 @@ let micromega_genr prover =
        match micromega_tauto  negate normalise unsat deduce spec prover env hyps' concl' gl with
        | None -> Tacticals.New.tclFAIL 0 (Pp.str " Cannot find witness") 
        | Some (ids,ff',res') -> 
-           let (ff,ids') = formula_hyps_concl 
+         let (ff,ids) = formula_hyps_concl 
 	     (List.filter (fun (n,_) -> List.mem n ids) hyps) concl in
+         let ff' = abstract_wrt_formula ff' ff  in
+
+         let (arith_goal,props,vars,ff_arith) = make_goal_of_formula (Lazy.force dump_rexpr)  ff' in
+         let intro (id,_) = Tactics.introduction id  in 
+
+       let intro_vars = Tacticals.New.tclTHENLIST (List.map intro vars) in
+       let intro_props = Tacticals.New.tclTHENLIST (List.map intro props) in
+       let ipat_of_name id = Some (Loc.ghost, Misctypes.IntroNaming (Misctypes.IntroIdentifier id)) in
+       let goal_name = Tactics.fresh_id [] (Names.Id.of_string "__arith") gl in
+       let env' = List.map (fun (id,i) -> Term.mkVar id,i) vars in 
+       
+       let tac_arith = Tacticals.New.tclTHENLIST [ intro_props ; intro_vars ; 
+                                                    micromega_order_changer res' env' ff_arith ] in
+
+       let goal_props = List.rev (prop_env_of_formula ff') in 
+
+       let goal_vars = List.map (fun (_,i) -> List.nth env (i-1)) vars in 
+       
+       let arith_args = goal_props @ goal_vars in
+
+       let kill_arith = 
+           Tacticals.New.tclTHEN
+             (Tactics.keep [])
+             ((*Tactics.tclABSTRACT  None*)
+                (Tacticals.New.tclTHEN tac_arith tac)) in 
+
+       Tacticals.New.tclTHENS
+         (Tactics.forward true (Some None) (ipat_of_name goal_name) arith_goal)
+         [
+           kill_arith;
            (Tacticals.New.tclTHENLIST
-              [
-                Tactics.generalize (List.map Term.mkVar ids) ;
-                micromega_order_changer res' env (abstract_wrt_formula ff' ff)
-              ])
-  with
-  | Mfourier.TimeOut     -> Tacticals.New.tclFAIL 0 (Pp.str "TimeOut")
-  | ParseError  -> Tacticals.New.tclFAIL 0 (Pp.str "Bad logical fragment")
-  | CsdpNotFound ->
-      Tacticals.New.tclFAIL 0 (Pp.str 
-      (" Skipping what remains of this tactic: the complexity of the goal requires "
-      ^ "the use of a specialized external tool called csdp. \n\n" 
-      ^ "Unfortunately Coq isn't aware of the presence of any \"csdp\" executable in the path. \n\n"
-       ^ "Csdp packages are provided by some OS distributions; binaries and source code can be downloaded from https://projects.coin-or.org/Csdp"))
-    end }
+            [(Tactics.generalize (List.map Term.mkVar ids));
+             Tactics.exact_check (Term.applist (Term.mkVar goal_name, arith_args))
+            ] )
+         ]
+
+    with
+    | ParseError  -> Tacticals.New.tclFAIL 0 (Pp.str "Bad logical fragment")
+    | Mfourier.TimeOut  -> Tacticals.New.tclFAIL 0 (Pp.str "Timeout")
+    | CsdpNotFound -> flush stdout ;
+     Tacticals.New.tclFAIL 0 (Pp.str 
+                           (" Skipping what remains of this tactic: the complexity of the goal requires "
+                            ^ "the use of a specialized external tool called csdp. \n\n" 
+                            ^ "Unfortunately Coq isn't aware of the presence of any \"csdp\" executable in the path. \n\n"
+                            ^ "Csdp packages are provided by some OS distributions; binaries and source code can be downloaded from https://projects.coin-or.org/Csdp"))
+  end }
+
+
 
 
 let micromega_genr prover  = (micromega_genr prover)
@@ -1851,7 +2160,7 @@ module Cache = PHashtable(struct
   let hash  = Hashtbl.hash
 end)
 
-let csdp_cache = "csdp.cache"
+let csdp_cache = ".csdp.cache"
 
 (**
   * Build the command to call csdpcert, and launch it. This in turn will call
@@ -1997,9 +2306,9 @@ module CacheQ = PHashtable(struct
   let hash  = Hashtbl.hash
 end)
 
-let memo_zlinear_prover = CacheZ.memo "lia.cache" (fun ((ce,b),s) -> lift_pexpr_prover (Certificate.lia ce b) s)
-let memo_nlia = CacheZ.memo "nlia.cache" (fun ((ce,b),s) -> lift_pexpr_prover (Certificate.nlia ce b) s)
-let memo_nra = CacheQ.memo "nra.cache" (fun (o,s) -> lift_pexpr_prover (Certificate.nlinear_prover o) s)
+let memo_zlinear_prover = CacheZ.memo ".lia.cache" (fun ((ce,b),s) -> lift_pexpr_prover (Certificate.lia ce b) s)
+let memo_nlia = CacheZ.memo ".nia.cache" (fun ((ce,b),s) -> lift_pexpr_prover (Certificate.nlia ce b) s)
+let memo_nra = CacheQ.memo ".nra.cache" (fun (o,s) -> lift_pexpr_prover (Certificate.nlinear_prover o) s)
 
 
  
@@ -2064,7 +2373,6 @@ let non_linear_prover_Z str o  = {
   pp_f    =  fun o x -> pp_pol pp_z o (fst x)
 }
 
-
 let linear_Z =   {
   name    = "lia";
  get_option = get_lia_option;
@@ -2100,19 +2408,15 @@ let tauto_lia ff =
   * solvers
   *)
 
-let psatzl_Z =
- micromega_gen parse_zarith  Mc.negate Mc.normalise Mc.zunsat Mc.zdeduce zz_domain_spec
-  [ linear_Z ] 
-
-let psatzl_Q =
- micromega_gen parse_qarith Mc.qnegate Mc.qnormalise Mc.qunsat Mc.qdeduce qq_domain_spec
+let lra_Q =
+ micromega_gen parse_qarith Mc.qnegate Mc.qnormalise Mc.qunsat Mc.qdeduce qq_domain_spec dump_qexpr
   [ linear_prover_Q ] 
 
 let psatz_Q i  =
- micromega_gen parse_qarith Mc.qnegate Mc.qnormalise Mc.qunsat Mc.qdeduce qq_domain_spec
+ micromega_gen parse_qarith Mc.qnegate Mc.qnormalise Mc.qunsat Mc.qdeduce qq_domain_spec dump_qexpr
   [ non_linear_prover_Q "real_nonlinear_prover" (Some i) ]
 
-let psatzl_R  =
+let lra_R  =
  micromega_genr [ linear_prover_R ]
 
 let psatz_R i  =
@@ -2120,15 +2424,15 @@ let psatz_R i  =
 
 
 let psatz_Z i  =
-    micromega_gen parse_zarith Mc.negate Mc.normalise Mc.zunsat Mc.zdeduce zz_domain_spec
+    micromega_gen parse_zarith Mc.negate Mc.normalise Mc.zunsat Mc.zdeduce zz_domain_spec dump_zexpr
       [ non_linear_prover_Z "real_nonlinear_prover" (Some i) ] 
 
 let sos_Z  =
- micromega_gen parse_zarith Mc.negate Mc.normalise  Mc.zunsat Mc.zdeduce zz_domain_spec
+ micromega_gen parse_zarith Mc.negate Mc.normalise  Mc.zunsat Mc.zdeduce zz_domain_spec dump_zexpr
   [ non_linear_prover_Z "pure_sos" None ] 
 
 let sos_Q  =
- micromega_gen parse_qarith Mc.qnegate Mc.qnormalise  Mc.qunsat Mc.qdeduce qq_domain_spec
+ micromega_gen parse_qarith Mc.qnegate Mc.qnormalise  Mc.qunsat Mc.qdeduce qq_domain_spec dump_qexpr
   [ non_linear_prover_Q "pure_sos" None ] 
 
 
@@ -2136,21 +2440,21 @@ let sos_R  =
  micromega_genr  [ non_linear_prover_R "pure_sos" None ] 
 
 
-let xlia  =
-  try 
-    micromega_gen parse_zarith Mc.negate Mc.normalise Mc.zunsat Mc.zdeduce zz_domain_spec
+let xlia  =  micromega_gen parse_zarith Mc.negate Mc.normalise Mc.zunsat Mc.zdeduce zz_domain_spec dump_zexpr
       [ linear_Z ] 
-  with reraise -> (*Printexc.print_backtrace stdout ;*) raise reraise
 
 let xnlia  =
-  try 
-    micromega_gen parse_zarith Mc.negate Mc.normalise Mc.zunsat Mc.zdeduce zz_domain_spec
+    micromega_gen parse_zarith Mc.negate Mc.normalise Mc.zunsat Mc.zdeduce zz_domain_spec dump_zexpr
       [ nlinear_Z ] 
-  with reraise -> (*Printexc.print_backtrace stdout ;*) raise reraise
 
 let nra  = 
  micromega_genr  [ nlinear_prover_R ] 
 
+let nqa  =
+ micromega_gen parse_qarith Mc.qnegate Mc.qnormalise Mc.qunsat Mc.qdeduce qq_domain_spec dump_qexpr
+  [ nlinear_prover_R ]
+
+   
 
 (* Local Variables: *)
 (* coding: utf-8 *)
diff --git a/plugins/micromega/g_micromega.ml4 b/plugins/micromega/g_micromega.ml4
index e6b5cc60d..79020ed03 100644
--- a/plugins/micromega/g_micromega.ml4
+++ b/plugins/micromega/g_micromega.ml4
@@ -16,54 +16,69 @@
 
 (*i camlp4deps: "grammar/grammar.cma" i*)
 
-open Constrarg
+open Stdarg
+open Tacarg
 
 DECLARE PLUGIN "micromega_plugin"
 
+TACTIC EXTEND RED
+| [ "myred"  ] -> [ Tactics.red_in_concl ]
+END
+
+
+
 TACTIC EXTEND PsatzZ
-| [ "psatz_Z" int_or_var(i) ] -> [  (Coq_micromega.psatz_Z i) ]
-| [ "psatz_Z" ] -> [  (Coq_micromega.psatz_Z (-1)) ]
+| [ "psatz_Z" int_or_var(i) tactic(t) ] -> [  (Coq_micromega.psatz_Z i
+                                               (Tacinterp.tactic_of_value ist t))
+                                               ]
+| [ "psatz_Z" tactic(t)] -> [  (Coq_micromega.psatz_Z (-1)) (Tacinterp.tactic_of_value ist t) ]
 END
 
 TACTIC EXTEND Lia
-[ "xlia"  ] -> [   (Coq_micromega.xlia) ]
+[ "xlia" tactic(t) ] -> [   (Coq_micromega.xlia (Tacinterp.tactic_of_value ist t)) ]
 END
 
 TACTIC EXTEND Nia
-[ "xnlia"  ] -> [  (Coq_micromega.xnlia) ]
+[ "xnlia" tactic(t) ] -> [  (Coq_micromega.xnlia (Tacinterp.tactic_of_value ist t)) ]
 END
 
 TACTIC EXTEND NRA
-[ "xnra"  ] -> [  (Coq_micromega.nra)]
+[ "xnra" tactic(t) ] -> [  (Coq_micromega.nra (Tacinterp.tactic_of_value ist t))]
 END
 
+TACTIC EXTEND NQA
+[ "xnqa" tactic(t) ] -> [  (Coq_micromega.nqa (Tacinterp.tactic_of_value ist t))]
+END
+
+
+  
 TACTIC EXTEND Sos_Z
-| [ "sos_Z" ] -> [ (Coq_micromega.sos_Z) ]
+| [ "sos_Z" tactic(t) ] -> [ (Coq_micromega.sos_Z (Tacinterp.tactic_of_value ist t)) ]
    END
 
 TACTIC EXTEND Sos_Q
-| [ "sos_Q" ] -> [   (Coq_micromega.sos_Q) ]
+| [ "sos_Q" tactic(t) ] -> [   (Coq_micromega.sos_Q (Tacinterp.tactic_of_value ist t)) ]
    END
 
 TACTIC EXTEND Sos_R
-| [ "sos_R" ] -> [   (Coq_micromega.sos_R) ]
+| [ "sos_R" tactic(t) ] -> [   (Coq_micromega.sos_R (Tacinterp.tactic_of_value ist t)) ]
 END
 
 TACTIC EXTEND LRA_Q
-[ "psatzl_Q"  ] -> [   (Coq_micromega.psatzl_Q) ]
+[ "lra_Q"  tactic(t) ] -> [   (Coq_micromega.lra_Q (Tacinterp.tactic_of_value ist t)) ]
 END
 
 TACTIC EXTEND LRA_R
-[ "psatzl_R"  ] -> [   (Coq_micromega.psatzl_R) ]
+[ "lra_R" tactic(t) ] -> [   (Coq_micromega.lra_R (Tacinterp.tactic_of_value ist t)) ]
 END
 
 TACTIC EXTEND PsatzR
-| [ "psatz_R" int_or_var(i) ] -> [   (Coq_micromega.psatz_R i) ]
-| [ "psatz_R" ] -> [   (Coq_micromega.psatz_R (-1)) ]
+| [ "psatz_R" int_or_var(i) tactic(t) ] -> [   (Coq_micromega.psatz_R i (Tacinterp.tactic_of_value ist t)) ]
+| [ "psatz_R" tactic(t) ] -> [   (Coq_micromega.psatz_R (-1) (Tacinterp.tactic_of_value ist t)) ]
 END
 
 TACTIC EXTEND PsatzQ
-| [ "psatz_Q" int_or_var(i) ] -> [  (Coq_micromega.psatz_Q i) ]
-| [ "psatz_Q" ] -> [  (Coq_micromega.psatz_Q (-1)) ]
+| [ "psatz_Q" int_or_var(i) tactic(t) ] -> [  (Coq_micromega.psatz_Q i (Tacinterp.tactic_of_value ist t)) ]
+| [ "psatz_Q" tactic(t) ] -> [  (Coq_micromega.psatz_Q (-1) (Tacinterp.tactic_of_value ist t)) ]
 END
 
diff --git a/plugins/micromega/mfourier.ml b/plugins/micromega/mfourier.ml
index e22fe5843..f4f9b3c2f 100644
--- a/plugins/micromega/mfourier.ml
+++ b/plugins/micromega/mfourier.ml
@@ -734,7 +734,7 @@ struct
 	| Inl (s,_) ->
 	    try
 	      Some (bound_of_variable IMap.empty fresh s.sys)
-	    with x when Errors.noncritical x ->
+	    with x when CErrors.noncritical x ->
 	      Printf.printf "optimise Exception : %s" (Printexc.to_string x);
               None
 
diff --git a/plugins/micromega/micromega.ml b/plugins/micromega/micromega.ml
index 0537cdbe8..5cf1da8ea 100644
--- a/plugins/micromega/micromega.ml
+++ b/plugins/micromega/micromega.ml
@@ -1,6 +1,3 @@
-type __ = Obj.t
-let __ = let rec f _ = Obj.repr f in Obj.repr f
-
 (** val negb : bool -> bool **)
 
 let negb = function
@@ -11,16 +8,6 @@ type nat =
 | O
 | S of nat
 
-(** val fst : ('a1 * 'a2) -> 'a1 **)
-
-let fst = function
-| x,y -> x
-
-(** val snd : ('a1 * 'a2) -> 'a2 **)
-
-let snd = function
-| x,y -> y
-
 (** val app : 'a1 list -> 'a1 list -> 'a1 list **)
 
 let rec app l m =
@@ -40,42 +27,15 @@ let compOpp = function
 | Lt -> Gt
 | Gt -> Lt
 
-type compareSpecT =
-| CompEqT
-| CompLtT
-| CompGtT
-
-(** val compareSpec2Type : comparison -> compareSpecT **)
-
-let compareSpec2Type = function
-| Eq -> CompEqT
-| Lt -> CompLtT
-| Gt -> CompGtT
-
-type 'a compSpecT = compareSpecT
-
-(** val compSpec2Type : 'a1 -> 'a1 -> comparison -> 'a1 compSpecT **)
-
-let compSpec2Type x y c =
-  compareSpec2Type c
-
-type 'a sig0 =
-  'a
-  (* singleton inductive, whose constructor was exist *)
-
-(** val plus : nat -> nat -> nat **)
-
-let rec plus n0 m =
-  match n0 with
-  | O -> m
-  | S p -> S (plus p m)
-
-(** val nat_iter : nat -> ('a1 -> 'a1) -> 'a1 -> 'a1 **)
+module Coq__1 = struct
+ (** val add : nat -> nat -> nat **)
+ let rec add n0 m =
+   match n0 with
+   | O -> m
+   | S p -> S (add p m)
+end
+let add = Coq__1.add
 
-let rec nat_iter n0 f x =
-  match n0 with
-  | O -> x
-  | S n' -> f (nat_iter n' f x)
 
 type positive =
 | XI of positive
@@ -91,592 +51,25 @@ type z =
 | Zpos of positive
 | Zneg of positive
 
-module type TotalOrder' = 
- sig 
-  type t 
- end
-
-module MakeOrderTac = 
- functor (O:TotalOrder') ->
- struct 
-  
- end
-
-module MaxLogicalProperties = 
- functor (O:TotalOrder') ->
- functor (M:sig 
-  val max : O.t -> O.t -> O.t
- end) ->
- struct 
-  module T = MakeOrderTac(O)
- end
-
-module Pos = 
- struct 
-  type t = positive
-  
-  (** val succ : positive -> positive **)
-  
-  let rec succ = function
-  | XI p -> XO (succ p)
-  | XO p -> XI p
-  | XH -> XO XH
-  
-  (** val add : positive -> positive -> positive **)
-  
-  let rec add x y =
-    match x with
-    | XI p ->
-      (match y with
-       | XI q0 -> XO (add_carry p q0)
-       | XO q0 -> XI (add p q0)
-       | XH -> XO (succ p))
-    | XO p ->
-      (match y with
-       | XI q0 -> XI (add p q0)
-       | XO q0 -> XO (add p q0)
-       | XH -> XI p)
-    | XH ->
-      (match y with
-       | XI q0 -> XO (succ q0)
-       | XO q0 -> XI q0
-       | XH -> XO XH)
-  
-  (** val add_carry : positive -> positive -> positive **)
-  
-  and add_carry x y =
-    match x with
-    | XI p ->
-      (match y with
-       | XI q0 -> XI (add_carry p q0)
-       | XO q0 -> XO (add_carry p q0)
-       | XH -> XI (succ p))
-    | XO p ->
-      (match y with
-       | XI q0 -> XO (add_carry p q0)
-       | XO q0 -> XI (add p q0)
-       | XH -> XO (succ p))
-    | XH ->
-      (match y with
-       | XI q0 -> XI (succ q0)
-       | XO q0 -> XO (succ q0)
-       | XH -> XI XH)
-  
-  (** val pred_double : positive -> positive **)
-  
-  let rec pred_double = function
-  | XI p -> XI (XO p)
-  | XO p -> XI (pred_double p)
-  | XH -> XH
-  
-  (** val pred : positive -> positive **)
-  
-  let pred = function
-  | XI p -> XO p
-  | XO p -> pred_double p
-  | XH -> XH
-  
-  (** val pred_N : positive -> n **)
-  
-  let pred_N = function
-  | XI p -> Npos (XO p)
-  | XO p -> Npos (pred_double p)
-  | XH -> N0
-  
+module Pos =
+ struct
   type mask =
   | IsNul
   | IsPos of positive
   | IsNeg
-  
-  (** val mask_rect : 'a1 -> (positive -> 'a1) -> 'a1 -> mask -> 'a1 **)
-  
-  let mask_rect f f0 f1 = function
-  | IsNul -> f
-  | IsPos x -> f0 x
-  | IsNeg -> f1
-  
-  (** val mask_rec : 'a1 -> (positive -> 'a1) -> 'a1 -> mask -> 'a1 **)
-  
-  let mask_rec f f0 f1 = function
-  | IsNul -> f
-  | IsPos x -> f0 x
-  | IsNeg -> f1
-  
-  (** val succ_double_mask : mask -> mask **)
-  
-  let succ_double_mask = function
-  | IsNul -> IsPos XH
-  | IsPos p -> IsPos (XI p)
-  | IsNeg -> IsNeg
-  
-  (** val double_mask : mask -> mask **)
-  
-  let double_mask = function
-  | IsPos p -> IsPos (XO p)
-  | x0 -> x0
-  
-  (** val double_pred_mask : positive -> mask **)
-  
-  let double_pred_mask = function
-  | XI p -> IsPos (XO (XO p))
-  | XO p -> IsPos (XO (pred_double p))
-  | XH -> IsNul
-  
-  (** val pred_mask : mask -> mask **)
-  
-  let pred_mask = function
-  | IsPos q0 ->
-    (match q0 with
-     | XH -> IsNul
-     | _ -> IsPos (pred q0))
-  | _ -> IsNeg
-  
-  (** val sub_mask : positive -> positive -> mask **)
-  
-  let rec sub_mask x y =
-    match x with
-    | XI p ->
-      (match y with
-       | XI q0 -> double_mask (sub_mask p q0)
-       | XO q0 -> succ_double_mask (sub_mask p q0)
-       | XH -> IsPos (XO p))
-    | XO p ->
-      (match y with
-       | XI q0 -> succ_double_mask (sub_mask_carry p q0)
-       | XO q0 -> double_mask (sub_mask p q0)
-       | XH -> IsPos (pred_double p))
-    | XH ->
-      (match y with
-       | XH -> IsNul
-       | _ -> IsNeg)
-  
-  (** val sub_mask_carry : positive -> positive -> mask **)
-  
-  and sub_mask_carry x y =
-    match x with
-    | XI p ->
-      (match y with
-       | XI q0 -> succ_double_mask (sub_mask_carry p q0)
-       | XO q0 -> double_mask (sub_mask p q0)
-       | XH -> IsPos (pred_double p))
-    | XO p ->
-      (match y with
-       | XI q0 -> double_mask (sub_mask_carry p q0)
-       | XO q0 -> succ_double_mask (sub_mask_carry p q0)
-       | XH -> double_pred_mask p)
-    | XH -> IsNeg
-  
-  (** val sub : positive -> positive -> positive **)
-  
-  let sub x y =
-    match sub_mask x y with
-    | IsPos z0 -> z0
-    | _ -> XH
-  
-  (** val mul : positive -> positive -> positive **)
-  
-  let rec mul x y =
-    match x with
-    | XI p -> add y (XO (mul p y))
-    | XO p -> XO (mul p y)
-    | XH -> y
-  
-  (** val iter : positive -> ('a1 -> 'a1) -> 'a1 -> 'a1 **)
-  
-  let rec iter n0 f x =
-    match n0 with
-    | XI n' -> f (iter n' f (iter n' f x))
-    | XO n' -> iter n' f (iter n' f x)
-    | XH -> f x
-  
-  (** val pow : positive -> positive -> positive **)
-  
-  let pow x y =
-    iter y (mul x) XH
-  
-  (** val div2 : positive -> positive **)
-  
-  let div2 = function
-  | XI p2 -> p2
-  | XO p2 -> p2
-  | XH -> XH
-  
-  (** val div2_up : positive -> positive **)
-  
-  let div2_up = function
-  | XI p2 -> succ p2
-  | XO p2 -> p2
-  | XH -> XH
-  
-  (** val size_nat : positive -> nat **)
-  
-  let rec size_nat = function
-  | XI p2 -> S (size_nat p2)
-  | XO p2 -> S (size_nat p2)
-  | XH -> S O
-  
-  (** val size : positive -> positive **)
-  
-  let rec size = function
-  | XI p2 -> succ (size p2)
-  | XO p2 -> succ (size p2)
-  | XH -> XH
-  
-  (** val compare_cont : positive -> positive -> comparison -> comparison **)
-  
-  let rec compare_cont x y r =
-    match x with
-    | XI p ->
-      (match y with
-       | XI q0 -> compare_cont p q0 r
-       | XO q0 -> compare_cont p q0 Gt
-       | XH -> Gt)
-    | XO p ->
-      (match y with
-       | XI q0 -> compare_cont p q0 Lt
-       | XO q0 -> compare_cont p q0 r
-       | XH -> Gt)
-    | XH ->
-      (match y with
-       | XH -> r
-       | _ -> Lt)
-  
-  (** val compare : positive -> positive -> comparison **)
-  
-  let compare x y =
-    compare_cont x y Eq
-  
-  (** val min : positive -> positive -> positive **)
-  
-  let min p p' =
-    match compare p p' with
-    | Gt -> p'
-    | _ -> p
-  
-  (** val max : positive -> positive -> positive **)
-  
-  let max p p' =
-    match compare p p' with
-    | Gt -> p
-    | _ -> p'
-  
-  (** val eqb : positive -> positive -> bool **)
-  
-  let rec eqb p q0 =
-    match p with
-    | XI p2 ->
-      (match q0 with
-       | XI q1 -> eqb p2 q1
-       | _ -> false)
-    | XO p2 ->
-      (match q0 with
-       | XO q1 -> eqb p2 q1
-       | _ -> false)
-    | XH ->
-      (match q0 with
-       | XH -> true
-       | _ -> false)
-  
-  (** val leb : positive -> positive -> bool **)
-  
-  let leb x y =
-    match compare x y with
-    | Gt -> false
-    | _ -> true
-  
-  (** val ltb : positive -> positive -> bool **)
-  
-  let ltb x y =
-    match compare x y with
-    | Lt -> true
-    | _ -> false
-  
-  (** val sqrtrem_step :
-      (positive -> positive) -> (positive -> positive) -> (positive * mask)
-      -> positive * mask **)
-  
-  let sqrtrem_step f g = function
-  | s,y ->
-    (match y with
-     | IsPos r ->
-       let s' = XI (XO s) in
-       let r' = g (f r) in
-       if leb s' r' then (XI s),(sub_mask r' s') else (XO s),(IsPos r')
-     | _ -> (XO s),(sub_mask (g (f XH)) (XO (XO XH))))
-  
-  (** val sqrtrem : positive -> positive * mask **)
-  
-  let rec sqrtrem = function
-  | XI p2 ->
-    (match p2 with
-     | XI p3 -> sqrtrem_step (fun x -> XI x) (fun x -> XI x) (sqrtrem p3)
-     | XO p3 -> sqrtrem_step (fun x -> XO x) (fun x -> XI x) (sqrtrem p3)
-     | XH -> XH,(IsPos (XO XH)))
-  | XO p2 ->
-    (match p2 with
-     | XI p3 -> sqrtrem_step (fun x -> XI x) (fun x -> XO x) (sqrtrem p3)
-     | XO p3 -> sqrtrem_step (fun x -> XO x) (fun x -> XO x) (sqrtrem p3)
-     | XH -> XH,(IsPos XH))
-  | XH -> XH,IsNul
-  
-  (** val sqrt : positive -> positive **)
-  
-  let sqrt p =
-    fst (sqrtrem p)
-  
-  (** val gcdn : nat -> positive -> positive -> positive **)
-  
-  let rec gcdn n0 a b =
-    match n0 with
-    | O -> XH
-    | S n1 ->
-      (match a with
-       | XI a' ->
-         (match b with
-          | XI b' ->
-            (match compare a' b' with
-             | Eq -> a
-             | Lt -> gcdn n1 (sub b' a') a
-             | Gt -> gcdn n1 (sub a' b') b)
-          | XO b0 -> gcdn n1 a b0
-          | XH -> XH)
-       | XO a0 ->
-         (match b with
-          | XI p -> gcdn n1 a0 b
-          | XO b0 -> XO (gcdn n1 a0 b0)
-          | XH -> XH)
-       | XH -> XH)
-  
-  (** val gcd : positive -> positive -> positive **)
-  
-  let gcd a b =
-    gcdn (plus (size_nat a) (size_nat b)) a b
-  
-  (** val ggcdn :
-      nat -> positive -> positive -> positive * (positive * positive) **)
-  
-  let rec ggcdn n0 a b =
-    match n0 with
-    | O -> XH,(a,b)
-    | S n1 ->
-      (match a with
-       | XI a' ->
-         (match b with
-          | XI b' ->
-            (match compare a' b' with
-             | Eq -> a,(XH,XH)
-             | Lt ->
-               let g,p = ggcdn n1 (sub b' a') a in
-               let ba,aa = p in g,(aa,(add aa (XO ba)))
-             | Gt ->
-               let g,p = ggcdn n1 (sub a' b') b in
-               let ab,bb = p in g,((add bb (XO ab)),bb))
-          | XO b0 ->
-            let g,p = ggcdn n1 a b0 in let aa,bb = p in g,(aa,(XO bb))
-          | XH -> XH,(a,XH))
-       | XO a0 ->
-         (match b with
-          | XI p ->
-            let g,p2 = ggcdn n1 a0 b in let aa,bb = p2 in g,((XO aa),bb)
-          | XO b0 -> let g,p = ggcdn n1 a0 b0 in (XO g),p
-          | XH -> XH,(a,XH))
-       | XH -> XH,(XH,b))
-  
-  (** val ggcd : positive -> positive -> positive * (positive * positive) **)
-  
-  let ggcd a b =
-    ggcdn (plus (size_nat a) (size_nat b)) a b
-  
-  (** val coq_Nsucc_double : n -> n **)
-  
-  let coq_Nsucc_double = function
-  | N0 -> Npos XH
-  | Npos p -> Npos (XI p)
-  
-  (** val coq_Ndouble : n -> n **)
-  
-  let coq_Ndouble = function
-  | N0 -> N0
-  | Npos p -> Npos (XO p)
-  
-  (** val coq_lor : positive -> positive -> positive **)
-  
-  let rec coq_lor p q0 =
-    match p with
-    | XI p2 ->
-      (match q0 with
-       | XI q1 -> XI (coq_lor p2 q1)
-       | XO q1 -> XI (coq_lor p2 q1)
-       | XH -> p)
-    | XO p2 ->
-      (match q0 with
-       | XI q1 -> XI (coq_lor p2 q1)
-       | XO q1 -> XO (coq_lor p2 q1)
-       | XH -> XI p2)
-    | XH ->
-      (match q0 with
-       | XO q1 -> XI q1
-       | _ -> q0)
-  
-  (** val coq_land : positive -> positive -> n **)
-  
-  let rec coq_land p q0 =
-    match p with
-    | XI p2 ->
-      (match q0 with
-       | XI q1 -> coq_Nsucc_double (coq_land p2 q1)
-       | XO q1 -> coq_Ndouble (coq_land p2 q1)
-       | XH -> Npos XH)
-    | XO p2 ->
-      (match q0 with
-       | XI q1 -> coq_Ndouble (coq_land p2 q1)
-       | XO q1 -> coq_Ndouble (coq_land p2 q1)
-       | XH -> N0)
-    | XH ->
-      (match q0 with
-       | XO q1 -> N0
-       | _ -> Npos XH)
-  
-  (** val ldiff : positive -> positive -> n **)
-  
-  let rec ldiff p q0 =
-    match p with
-    | XI p2 ->
-      (match q0 with
-       | XI q1 -> coq_Ndouble (ldiff p2 q1)
-       | XO q1 -> coq_Nsucc_double (ldiff p2 q1)
-       | XH -> Npos (XO p2))
-    | XO p2 ->
-      (match q0 with
-       | XI q1 -> coq_Ndouble (ldiff p2 q1)
-       | XO q1 -> coq_Ndouble (ldiff p2 q1)
-       | XH -> Npos p)
-    | XH ->
-      (match q0 with
-       | XO q1 -> Npos XH
-       | _ -> N0)
-  
-  (** val coq_lxor : positive -> positive -> n **)
-  
-  let rec coq_lxor p q0 =
-    match p with
-    | XI p2 ->
-      (match q0 with
-       | XI q1 -> coq_Ndouble (coq_lxor p2 q1)
-       | XO q1 -> coq_Nsucc_double (coq_lxor p2 q1)
-       | XH -> Npos (XO p2))
-    | XO p2 ->
-      (match q0 with
-       | XI q1 -> coq_Nsucc_double (coq_lxor p2 q1)
-       | XO q1 -> coq_Ndouble (coq_lxor p2 q1)
-       | XH -> Npos (XI p2))
-    | XH ->
-      (match q0 with
-       | XI q1 -> Npos (XO q1)
-       | XO q1 -> Npos (XI q1)
-       | XH -> N0)
-  
-  (** val shiftl_nat : positive -> nat -> positive **)
-  
-  let shiftl_nat p n0 =
-    nat_iter n0 (fun x -> XO x) p
-  
-  (** val shiftr_nat : positive -> nat -> positive **)
-  
-  let shiftr_nat p n0 =
-    nat_iter n0 div2 p
-  
-  (** val shiftl : positive -> n -> positive **)
-  
-  let shiftl p = function
-  | N0 -> p
-  | Npos n1 -> iter n1 (fun x -> XO x) p
-  
-  (** val shiftr : positive -> n -> positive **)
-  
-  let shiftr p = function
-  | N0 -> p
-  | Npos n1 -> iter n1 div2 p
-  
-  (** val testbit_nat : positive -> nat -> bool **)
-  
-  let rec testbit_nat p n0 =
-    match p with
-    | XI p2 ->
-      (match n0 with
-       | O -> true
-       | S n' -> testbit_nat p2 n')
-    | XO p2 ->
-      (match n0 with
-       | O -> false
-       | S n' -> testbit_nat p2 n')
-    | XH ->
-      (match n0 with
-       | O -> true
-       | S n1 -> false)
-  
-  (** val testbit : positive -> n -> bool **)
-  
-  let rec testbit p n0 =
-    match p with
-    | XI p2 ->
-      (match n0 with
-       | N0 -> true
-       | Npos n1 -> testbit p2 (pred_N n1))
-    | XO p2 ->
-      (match n0 with
-       | N0 -> false
-       | Npos n1 -> testbit p2 (pred_N n1))
-    | XH ->
-      (match n0 with
-       | N0 -> true
-       | Npos p2 -> false)
-  
-  (** val iter_op : ('a1 -> 'a1 -> 'a1) -> positive -> 'a1 -> 'a1 **)
-  
-  let rec iter_op op p a =
-    match p with
-    | XI p2 -> op a (iter_op op p2 (op a a))
-    | XO p2 -> iter_op op p2 (op a a)
-    | XH -> a
-  
-  (** val to_nat : positive -> nat **)
-  
-  let to_nat x =
-    iter_op plus x (S O)
-  
-  (** val of_nat : nat -> positive **)
-  
-  let rec of_nat = function
-  | O -> XH
-  | S x ->
-    (match x with
-     | O -> XH
-     | S n1 -> succ (of_nat x))
-  
-  (** val of_succ_nat : nat -> positive **)
-  
-  let rec of_succ_nat = function
-  | O -> XH
-  | S x -> succ (of_succ_nat x)
  end
 
-module Coq_Pos = 
- struct 
-  module Coq__1 = struct 
-   type t = positive
-  end
-  type t = Coq__1.t
-  
+module Coq_Pos =
+ struct
   (** val succ : positive -> positive **)
-  
+
   let rec succ = function
   | XI p -> XO (succ p)
   | XO p -> XI p
   | XH -> XO XH
-  
+
   (** val add : positive -> positive -> positive **)
-  
+
   let rec add x y =
     match x with
     | XI p ->
@@ -694,9 +87,9 @@ module Coq_Pos =
        | XI q0 -> XO (succ q0)
        | XO q0 -> XI q0
        | XH -> XO XH)
-  
+
   (** val add_carry : positive -> positive -> positive **)
-  
+
   and add_carry x y =
     match x with
     | XI p ->
@@ -714,78 +107,41 @@ module Coq_Pos =
        | XI q0 -> XI (succ q0)
        | XO q0 -> XO (succ q0)
        | XH -> XI XH)
-  
+
   (** val pred_double : positive -> positive **)
-  
+
   let rec pred_double = function
   | XI p -> XI (XO p)
   | XO p -> XI (pred_double p)
   | XH -> XH
-  
-  (** val pred : positive -> positive **)
-  
-  let pred = function
-  | XI p -> XO p
-  | XO p -> pred_double p
-  | XH -> XH
-  
-  (** val pred_N : positive -> n **)
-  
-  let pred_N = function
-  | XI p -> Npos (XO p)
-  | XO p -> Npos (pred_double p)
-  | XH -> N0
-  
+
   type mask = Pos.mask =
   | IsNul
   | IsPos of positive
   | IsNeg
-  
-  (** val mask_rect : 'a1 -> (positive -> 'a1) -> 'a1 -> mask -> 'a1 **)
-  
-  let mask_rect f f0 f1 = function
-  | IsNul -> f
-  | IsPos x -> f0 x
-  | IsNeg -> f1
-  
-  (** val mask_rec : 'a1 -> (positive -> 'a1) -> 'a1 -> mask -> 'a1 **)
-  
-  let mask_rec f f0 f1 = function
-  | IsNul -> f
-  | IsPos x -> f0 x
-  | IsNeg -> f1
-  
+
   (** val succ_double_mask : mask -> mask **)
-  
+
   let succ_double_mask = function
   | IsNul -> IsPos XH
   | IsPos p -> IsPos (XI p)
   | IsNeg -> IsNeg
-  
+
   (** val double_mask : mask -> mask **)
-  
+
   let double_mask = function
   | IsPos p -> IsPos (XO p)
   | x0 -> x0
-  
+
   (** val double_pred_mask : positive -> mask **)
-  
+
   let double_pred_mask = function
   | XI p -> IsPos (XO (XO p))
   | XO p -> IsPos (XO (pred_double p))
   | XH -> IsNul
-  
-  (** val pred_mask : mask -> mask **)
-  
-  let pred_mask = function
-  | IsPos q0 ->
-    (match q0 with
-     | XH -> IsNul
-     | _ -> IsPos (pred q0))
-  | _ -> IsNeg
-  
+
   (** val sub_mask : positive -> positive -> mask **)
-  
+
   let rec sub_mask x y =
     match x with
     | XI p ->
@@ -802,9 +158,9 @@ module Coq_Pos =
       (match y with
        | XH -> IsNul
        | _ -> IsNeg)
-  
+
   (** val sub_mask_carry : positive -> positive -> mask **)
-  
+
   and sub_mask_carry x y =
     match x with
     | XI p ->
@@ -818,167 +174,56 @@ module Coq_Pos =
        | XO q0 -> succ_double_mask (sub_mask_carry p q0)
        | XH -> double_pred_mask p)
     | XH -> IsNeg
-  
+
   (** val sub : positive -> positive -> positive **)
-  
+
   let sub x y =
     match sub_mask x y with
     | IsPos z0 -> z0
     | _ -> XH
-  
+
   (** val mul : positive -> positive -> positive **)
-  
+
   let rec mul x y =
     match x with
     | XI p -> add y (XO (mul p y))
     | XO p -> XO (mul p y)
     | XH -> y
-  
-  (** val iter : positive -> ('a1 -> 'a1) -> 'a1 -> 'a1 **)
-  
-  let rec iter n0 f x =
-    match n0 with
-    | XI n' -> f (iter n' f (iter n' f x))
-    | XO n' -> iter n' f (iter n' f x)
-    | XH -> f x
-  
-  (** val pow : positive -> positive -> positive **)
-  
-  let pow x y =
-    iter y (mul x) XH
-  
-  (** val div2 : positive -> positive **)
-  
-  let div2 = function
-  | XI p2 -> p2
-  | XO p2 -> p2
-  | XH -> XH
-  
-  (** val div2_up : positive -> positive **)
-  
-  let div2_up = function
-  | XI p2 -> succ p2
-  | XO p2 -> p2
-  | XH -> XH
-  
+
   (** val size_nat : positive -> nat **)
-  
+
   let rec size_nat = function
   | XI p2 -> S (size_nat p2)
   | XO p2 -> S (size_nat p2)
   | XH -> S O
-  
-  (** val size : positive -> positive **)
-  
-  let rec size = function
-  | XI p2 -> succ (size p2)
-  | XO p2 -> succ (size p2)
-  | XH -> XH
-  
-  (** val compare_cont : positive -> positive -> comparison -> comparison **)
-  
-  let rec compare_cont x y r =
+
+  (** val compare_cont :
+      comparison -> positive -> positive -> comparison **)
+
+  let rec compare_cont r x y =
     match x with
     | XI p ->
       (match y with
-       | XI q0 -> compare_cont p q0 r
-       | XO q0 -> compare_cont p q0 Gt
+       | XI q0 -> compare_cont r p q0
+       | XO q0 -> compare_cont Gt p q0
        | XH -> Gt)
     | XO p ->
       (match y with
-       | XI q0 -> compare_cont p q0 Lt
-       | XO q0 -> compare_cont p q0 r
+       | XI q0 -> compare_cont Lt p q0
+       | XO q0 -> compare_cont r p q0
        | XH -> Gt)
     | XH ->
       (match y with
        | XH -> r
        | _ -> Lt)
-  
+
   (** val compare : positive -> positive -> comparison **)
-  
-  let compare x y =
-    compare_cont x y Eq
-  
-  (** val min : positive -> positive -> positive **)
-  
-  let min p p' =
-    match compare p p' with
-    | Gt -> p'
-    | _ -> p
-  
-  (** val max : positive -> positive -> positive **)
-  
-  let max p p' =
-    match compare p p' with
-    | Gt -> p
-    | _ -> p'
-  
-  (** val eqb : positive -> positive -> bool **)
-  
-  let rec eqb p q0 =
-    match p with
-    | XI p2 ->
-      (match q0 with
-       | XI q1 -> eqb p2 q1
-       | _ -> false)
-    | XO p2 ->
-      (match q0 with
-       | XO q1 -> eqb p2 q1
-       | _ -> false)
-    | XH ->
-      (match q0 with
-       | XH -> true
-       | _ -> false)
-  
-  (** val leb : positive -> positive -> bool **)
-  
-  let leb x y =
-    match compare x y with
-    | Gt -> false
-    | _ -> true
-  
-  (** val ltb : positive -> positive -> bool **)
-  
-  let ltb x y =
-    match compare x y with
-    | Lt -> true
-    | _ -> false
-  
-  (** val sqrtrem_step :
-      (positive -> positive) -> (positive -> positive) -> (positive * mask)
-      -> positive * mask **)
-  
-  let sqrtrem_step f g = function
-  | s,y ->
-    (match y with
-     | IsPos r ->
-       let s' = XI (XO s) in
-       let r' = g (f r) in
-       if leb s' r' then (XI s),(sub_mask r' s') else (XO s),(IsPos r')
-     | _ -> (XO s),(sub_mask (g (f XH)) (XO (XO XH))))
-  
-  (** val sqrtrem : positive -> positive * mask **)
-  
-  let rec sqrtrem = function
-  | XI p2 ->
-    (match p2 with
-     | XI p3 -> sqrtrem_step (fun x -> XI x) (fun x -> XI x) (sqrtrem p3)
-     | XO p3 -> sqrtrem_step (fun x -> XO x) (fun x -> XI x) (sqrtrem p3)
-     | XH -> XH,(IsPos (XO XH)))
-  | XO p2 ->
-    (match p2 with
-     | XI p3 -> sqrtrem_step (fun x -> XI x) (fun x -> XO x) (sqrtrem p3)
-     | XO p3 -> sqrtrem_step (fun x -> XO x) (fun x -> XO x) (sqrtrem p3)
-     | XH -> XH,(IsPos XH))
-  | XH -> XH,IsNul
-  
-  (** val sqrt : positive -> positive **)
-  
-  let sqrt p =
-    fst (sqrtrem p)
-  
+
+  let compare =
+    compare_cont Eq
+
   (** val gcdn : nat -> positive -> positive -> positive **)
-  
+
   let rec gcdn n0 a b =
     match n0 with
     | O -> XH
@@ -995,1001 +240,30 @@ module Coq_Pos =
           | XH -> XH)
        | XO a0 ->
          (match b with
-          | XI p -> gcdn n1 a0 b
+          | XI _ -> gcdn n1 a0 b
           | XO b0 -> XO (gcdn n1 a0 b0)
           | XH -> XH)
        | XH -> XH)
-  
+
   (** val gcd : positive -> positive -> positive **)
-  
+
   let gcd a b =
-    gcdn (plus (size_nat a) (size_nat b)) a b
-  
-  (** val ggcdn :
-      nat -> positive -> positive -> positive * (positive * positive) **)
-  
-  let rec ggcdn n0 a b =
-    match n0 with
-    | O -> XH,(a,b)
-    | S n1 ->
-      (match a with
-       | XI a' ->
-         (match b with
-          | XI b' ->
-            (match compare a' b' with
-             | Eq -> a,(XH,XH)
-             | Lt ->
-               let g,p = ggcdn n1 (sub b' a') a in
-               let ba,aa = p in g,(aa,(add aa (XO ba)))
-             | Gt ->
-               let g,p = ggcdn n1 (sub a' b') b in
-               let ab,bb = p in g,((add bb (XO ab)),bb))
-          | XO b0 ->
-            let g,p = ggcdn n1 a b0 in let aa,bb = p in g,(aa,(XO bb))
-          | XH -> XH,(a,XH))
-       | XO a0 ->
-         (match b with
-          | XI p ->
-            let g,p2 = ggcdn n1 a0 b in let aa,bb = p2 in g,((XO aa),bb)
-          | XO b0 -> let g,p = ggcdn n1 a0 b0 in (XO g),p
-          | XH -> XH,(a,XH))
-       | XH -> XH,(XH,b))
-  
-  (** val ggcd : positive -> positive -> positive * (positive * positive) **)
-  
-  let ggcd a b =
-    ggcdn (plus (size_nat a) (size_nat b)) a b
-  
-  (** val coq_Nsucc_double : n -> n **)
-  
-  let coq_Nsucc_double = function
-  | N0 -> Npos XH
-  | Npos p -> Npos (XI p)
-  
-  (** val coq_Ndouble : n -> n **)
-  
-  let coq_Ndouble = function
-  | N0 -> N0
-  | Npos p -> Npos (XO p)
-  
-  (** val coq_lor : positive -> positive -> positive **)
-  
-  let rec coq_lor p q0 =
-    match p with
-    | XI p2 ->
-      (match q0 with
-       | XI q1 -> XI (coq_lor p2 q1)
-       | XO q1 -> XI (coq_lor p2 q1)
-       | XH -> p)
-    | XO p2 ->
-      (match q0 with
-       | XI q1 -> XI (coq_lor p2 q1)
-       | XO q1 -> XO (coq_lor p2 q1)
-       | XH -> XI p2)
-    | XH ->
-      (match q0 with
-       | XO q1 -> XI q1
-       | _ -> q0)
-  
-  (** val coq_land : positive -> positive -> n **)
-  
-  let rec coq_land p q0 =
-    match p with
-    | XI p2 ->
-      (match q0 with
-       | XI q1 -> coq_Nsucc_double (coq_land p2 q1)
-       | XO q1 -> coq_Ndouble (coq_land p2 q1)
-       | XH -> Npos XH)
-    | XO p2 ->
-      (match q0 with
-       | XI q1 -> coq_Ndouble (coq_land p2 q1)
-       | XO q1 -> coq_Ndouble (coq_land p2 q1)
-       | XH -> N0)
-    | XH ->
-      (match q0 with
-       | XO q1 -> N0
-       | _ -> Npos XH)
-  
-  (** val ldiff : positive -> positive -> n **)
-  
-  let rec ldiff p q0 =
-    match p with
-    | XI p2 ->
-      (match q0 with
-       | XI q1 -> coq_Ndouble (ldiff p2 q1)
-       | XO q1 -> coq_Nsucc_double (ldiff p2 q1)
-       | XH -> Npos (XO p2))
-    | XO p2 ->
-      (match q0 with
-       | XI q1 -> coq_Ndouble (ldiff p2 q1)
-       | XO q1 -> coq_Ndouble (ldiff p2 q1)
-       | XH -> Npos p)
-    | XH ->
-      (match q0 with
-       | XO q1 -> Npos XH
-       | _ -> N0)
-  
-  (** val coq_lxor : positive -> positive -> n **)
-  
-  let rec coq_lxor p q0 =
-    match p with
-    | XI p2 ->
-      (match q0 with
-       | XI q1 -> coq_Ndouble (coq_lxor p2 q1)
-       | XO q1 -> coq_Nsucc_double (coq_lxor p2 q1)
-       | XH -> Npos (XO p2))
-    | XO p2 ->
-      (match q0 with
-       | XI q1 -> coq_Nsucc_double (coq_lxor p2 q1)
-       | XO q1 -> coq_Ndouble (coq_lxor p2 q1)
-       | XH -> Npos (XI p2))
-    | XH ->
-      (match q0 with
-       | XI q1 -> Npos (XO q1)
-       | XO q1 -> Npos (XI q1)
-       | XH -> N0)
-  
-  (** val shiftl_nat : positive -> nat -> positive **)
-  
-  let shiftl_nat p n0 =
-    nat_iter n0 (fun x -> XO x) p
-  
-  (** val shiftr_nat : positive -> nat -> positive **)
-  
-  let shiftr_nat p n0 =
-    nat_iter n0 div2 p
-  
-  (** val shiftl : positive -> n -> positive **)
-  
-  let shiftl p = function
-  | N0 -> p
-  | Npos n1 -> iter n1 (fun x -> XO x) p
-  
-  (** val shiftr : positive -> n -> positive **)
-  
-  let shiftr p = function
-  | N0 -> p
-  | Npos n1 -> iter n1 div2 p
-  
-  (** val testbit_nat : positive -> nat -> bool **)
-  
-  let rec testbit_nat p n0 =
-    match p with
-    | XI p2 ->
-      (match n0 with
-       | O -> true
-       | S n' -> testbit_nat p2 n')
-    | XO p2 ->
-      (match n0 with
-       | O -> false
-       | S n' -> testbit_nat p2 n')
-    | XH ->
-      (match n0 with
-       | O -> true
-       | S n1 -> false)
-  
-  (** val testbit : positive -> n -> bool **)
-  
-  let rec testbit p n0 =
-    match p with
-    | XI p2 ->
-      (match n0 with
-       | N0 -> true
-       | Npos n1 -> testbit p2 (pred_N n1))
-    | XO p2 ->
-      (match n0 with
-       | N0 -> false
-       | Npos n1 -> testbit p2 (pred_N n1))
-    | XH ->
-      (match n0 with
-       | N0 -> true
-       | Npos p2 -> false)
-  
-  (** val iter_op : ('a1 -> 'a1 -> 'a1) -> positive -> 'a1 -> 'a1 **)
-  
-  let rec iter_op op p a =
-    match p with
-    | XI p2 -> op a (iter_op op p2 (op a a))
-    | XO p2 -> iter_op op p2 (op a a)
-    | XH -> a
-  
-  (** val to_nat : positive -> nat **)
-  
-  let to_nat x =
-    iter_op plus x (S O)
-  
-  (** val of_nat : nat -> positive **)
-  
-  let rec of_nat = function
-  | O -> XH
-  | S x ->
-    (match x with
-     | O -> XH
-     | S n1 -> succ (of_nat x))
-  
+    gcdn (Coq__1.add (size_nat a) (size_nat b)) a b
+
   (** val of_succ_nat : nat -> positive **)
-  
+
   let rec of_succ_nat = function
   | O -> XH
   | S x -> succ (of_succ_nat x)
-  
-  (** val eq_dec : positive -> positive -> bool **)
-  
-  let rec eq_dec p y0 =
-    match p with
-    | XI p2 ->
-      (match y0 with
-       | XI p3 -> eq_dec p2 p3
-       | _ -> false)
-    | XO p2 ->
-      (match y0 with
-       | XO p3 -> eq_dec p2 p3
-       | _ -> false)
-    | XH ->
-      (match y0 with
-       | XH -> true
-       | _ -> false)
-  
-  (** val peano_rect : 'a1 -> (positive -> 'a1 -> 'a1) -> positive -> 'a1 **)
-  
-  let rec peano_rect a f p =
-    let f2 = peano_rect (f XH a) (fun p2 x -> f (succ (XO p2)) (f (XO p2) x))
-    in
-    (match p with
-     | XI q0 -> f (XO q0) (f2 q0)
-     | XO q0 -> f2 q0
-     | XH -> a)
-  
-  (** val peano_rec : 'a1 -> (positive -> 'a1 -> 'a1) -> positive -> 'a1 **)
-  
-  let peano_rec =
-    peano_rect
-  
-  type coq_PeanoView =
-  | PeanoOne
-  | PeanoSucc of positive * coq_PeanoView
-  
-  (** val coq_PeanoView_rect :
-      'a1 -> (positive -> coq_PeanoView -> 'a1 -> 'a1) -> positive ->
-      coq_PeanoView -> 'a1 **)
-  
-  let rec coq_PeanoView_rect f f0 p = function
-  | PeanoOne -> f
-  | PeanoSucc (p3, p4) -> f0 p3 p4 (coq_PeanoView_rect f f0 p3 p4)
-  
-  (** val coq_PeanoView_rec :
-      'a1 -> (positive -> coq_PeanoView -> 'a1 -> 'a1) -> positive ->
-      coq_PeanoView -> 'a1 **)
-  
-  let rec coq_PeanoView_rec f f0 p = function
-  | PeanoOne -> f
-  | PeanoSucc (p3, p4) -> f0 p3 p4 (coq_PeanoView_rec f f0 p3 p4)
-  
-  (** val peanoView_xO : positive -> coq_PeanoView -> coq_PeanoView **)
-  
-  let rec peanoView_xO p = function
-  | PeanoOne -> PeanoSucc (XH, PeanoOne)
-  | PeanoSucc (p2, q1) ->
-    PeanoSucc ((succ (XO p2)), (PeanoSucc ((XO p2), (peanoView_xO p2 q1))))
-  
-  (** val peanoView_xI : positive -> coq_PeanoView -> coq_PeanoView **)
-  
-  let rec peanoView_xI p = function
-  | PeanoOne -> PeanoSucc ((succ XH), (PeanoSucc (XH, PeanoOne)))
-  | PeanoSucc (p2, q1) ->
-    PeanoSucc ((succ (XI p2)), (PeanoSucc ((XI p2), (peanoView_xI p2 q1))))
-  
-  (** val peanoView : positive -> coq_PeanoView **)
-  
-  let rec peanoView = function
-  | XI p2 -> peanoView_xI p2 (peanoView p2)
-  | XO p2 -> peanoView_xO p2 (peanoView p2)
-  | XH -> PeanoOne
-  
-  (** val coq_PeanoView_iter :
-      'a1 -> (positive -> 'a1 -> 'a1) -> positive -> coq_PeanoView -> 'a1 **)
-  
-  let rec coq_PeanoView_iter a f p = function
-  | PeanoOne -> a
-  | PeanoSucc (p2, q1) -> f p2 (coq_PeanoView_iter a f p2 q1)
-  
-  (** val switch_Eq : comparison -> comparison -> comparison **)
-  
-  let switch_Eq c = function
-  | Eq -> c
-  | x -> x
-  
-  (** val mask2cmp : mask -> comparison **)
-  
-  let mask2cmp = function
-  | IsNul -> Eq
-  | IsPos p2 -> Gt
-  | IsNeg -> Lt
-  
-  module T = 
-   struct 
-    
-   end
-  
-  module ORev = 
-   struct 
-    type t = Coq__1.t
-   end
-  
-  module MRev = 
-   struct 
-    (** val max : t -> t -> t **)
-    
-    let max x y =
-      min y x
-   end
-  
-  module MPRev = MaxLogicalProperties(ORev)(MRev)
-  
-  module P = 
-   struct 
-    (** val max_case_strong :
-        t -> t -> (t -> t -> __ -> 'a1 -> 'a1) -> (__ -> 'a1) -> (__ -> 'a1)
-        -> 'a1 **)
-    
-    let max_case_strong n0 m compat hl hr =
-      let c = compSpec2Type n0 m (compare n0 m) in
-      (match c with
-       | CompGtT -> compat n0 (max n0 m) __ (hl __)
-       | _ -> compat m (max n0 m) __ (hr __))
-    
-    (** val max_case :
-        t -> t -> (t -> t -> __ -> 'a1 -> 'a1) -> 'a1 -> 'a1 -> 'a1 **)
-    
-    let max_case n0 m x x0 x1 =
-      max_case_strong n0 m x (fun _ -> x0) (fun _ -> x1)
-    
-    (** val max_dec : t -> t -> bool **)
-    
-    let max_dec n0 m =
-      max_case n0 m (fun x y _ h0 -> h0) true false
-    
-    (** val min_case_strong :
-        t -> t -> (t -> t -> __ -> 'a1 -> 'a1) -> (__ -> 'a1) -> (__ -> 'a1)
-        -> 'a1 **)
-    
-    let min_case_strong n0 m compat hl hr =
-      let c = compSpec2Type n0 m (compare n0 m) in
-      (match c with
-       | CompGtT -> compat m (min n0 m) __ (hr __)
-       | _ -> compat n0 (min n0 m) __ (hl __))
-    
-    (** val min_case :
-        t -> t -> (t -> t -> __ -> 'a1 -> 'a1) -> 'a1 -> 'a1 -> 'a1 **)
-    
-    let min_case n0 m x x0 x1 =
-      min_case_strong n0 m x (fun _ -> x0) (fun _ -> x1)
-    
-    (** val min_dec : t -> t -> bool **)
-    
-    let min_dec n0 m =
-      min_case n0 m (fun x y _ h0 -> h0) true false
-   end
-  
-  (** val max_case_strong : t -> t -> (__ -> 'a1) -> (__ -> 'a1) -> 'a1 **)
-  
-  let max_case_strong n0 m x x0 =
-    P.max_case_strong n0 m (fun x1 y _ x2 -> x2) x x0
-  
-  (** val max_case : t -> t -> 'a1 -> 'a1 -> 'a1 **)
-  
-  let max_case n0 m x x0 =
-    max_case_strong n0 m (fun _ -> x) (fun _ -> x0)
-  
-  (** val max_dec : t -> t -> bool **)
-  
-  let max_dec =
-    P.max_dec
-  
-  (** val min_case_strong : t -> t -> (__ -> 'a1) -> (__ -> 'a1) -> 'a1 **)
-  
-  let min_case_strong n0 m x x0 =
-    P.min_case_strong n0 m (fun x1 y _ x2 -> x2) x x0
-  
-  (** val min_case : t -> t -> 'a1 -> 'a1 -> 'a1 **)
-  
-  let min_case n0 m x x0 =
-    min_case_strong n0 m (fun _ -> x) (fun _ -> x0)
-  
-  (** val min_dec : t -> t -> bool **)
-  
-  let min_dec =
-    P.min_dec
  end
 
-module N = 
- struct 
-  type t = n
-  
-  (** val zero : n **)
-  
-  let zero =
-    N0
-  
-  (** val one : n **)
-  
-  let one =
-    Npos XH
-  
-  (** val two : n **)
-  
-  let two =
-    Npos (XO XH)
-  
-  (** val succ_double : n -> n **)
-  
-  let succ_double = function
-  | N0 -> Npos XH
-  | Npos p -> Npos (XI p)
-  
-  (** val double : n -> n **)
-  
-  let double = function
-  | N0 -> N0
-  | Npos p -> Npos (XO p)
-  
-  (** val succ : n -> n **)
-  
-  let succ = function
-  | N0 -> Npos XH
-  | Npos p -> Npos (Coq_Pos.succ p)
-  
-  (** val pred : n -> n **)
-  
-  let pred = function
-  | N0 -> N0
-  | Npos p -> Coq_Pos.pred_N p
-  
-  (** val succ_pos : n -> positive **)
-  
-  let succ_pos = function
-  | N0 -> XH
-  | Npos p -> Coq_Pos.succ p
-  
-  (** val add : n -> n -> n **)
-  
-  let add n0 m =
-    match n0 with
-    | N0 -> m
-    | Npos p ->
-      (match m with
-       | N0 -> n0
-       | Npos q0 -> Npos (Coq_Pos.add p q0))
-  
-  (** val sub : n -> n -> n **)
-  
-  let sub n0 m =
-    match n0 with
-    | N0 -> N0
-    | Npos n' ->
-      (match m with
-       | N0 -> n0
-       | Npos m' ->
-         (match Coq_Pos.sub_mask n' m' with
-          | Coq_Pos.IsPos p -> Npos p
-          | _ -> N0))
-  
-  (** val mul : n -> n -> n **)
-  
-  let mul n0 m =
-    match n0 with
-    | N0 -> N0
-    | Npos p ->
-      (match m with
-       | N0 -> N0
-       | Npos q0 -> Npos (Coq_Pos.mul p q0))
-  
-  (** val compare : n -> n -> comparison **)
-  
-  let compare n0 m =
-    match n0 with
-    | N0 ->
-      (match m with
-       | N0 -> Eq
-       | Npos m' -> Lt)
-    | Npos n' ->
-      (match m with
-       | N0 -> Gt
-       | Npos m' -> Coq_Pos.compare n' m')
-  
-  (** val eqb : n -> n -> bool **)
-  
-  let eqb n0 m =
-    match n0 with
-    | N0 ->
-      (match m with
-       | N0 -> true
-       | Npos p -> false)
-    | Npos p ->
-      (match m with
-       | N0 -> false
-       | Npos q0 -> Coq_Pos.eqb p q0)
-  
-  (** val leb : n -> n -> bool **)
-  
-  let leb x y =
-    match compare x y with
-    | Gt -> false
-    | _ -> true
-  
-  (** val ltb : n -> n -> bool **)
-  
-  let ltb x y =
-    match compare x y with
-    | Lt -> true
-    | _ -> false
-  
-  (** val min : n -> n -> n **)
-  
-  let min n0 n' =
-    match compare n0 n' with
-    | Gt -> n'
-    | _ -> n0
-  
-  (** val max : n -> n -> n **)
-  
-  let max n0 n' =
-    match compare n0 n' with
-    | Gt -> n0
-    | _ -> n'
-  
-  (** val div2 : n -> n **)
-  
-  let div2 = function
-  | N0 -> N0
-  | Npos p2 ->
-    (match p2 with
-     | XI p -> Npos p
-     | XO p -> Npos p
-     | XH -> N0)
-  
-  (** val even : n -> bool **)
-  
-  let even = function
-  | N0 -> true
-  | Npos p ->
-    (match p with
-     | XO p2 -> true
-     | _ -> false)
-  
-  (** val odd : n -> bool **)
-  
-  let odd n0 =
-    negb (even n0)
-  
-  (** val pow : n -> n -> n **)
-  
-  let pow n0 = function
-  | N0 -> Npos XH
-  | Npos p2 ->
-    (match n0 with
-     | N0 -> N0
-     | Npos q0 -> Npos (Coq_Pos.pow q0 p2))
-  
-  (** val log2 : n -> n **)
-  
-  let log2 = function
-  | N0 -> N0
-  | Npos p2 ->
-    (match p2 with
-     | XI p -> Npos (Coq_Pos.size p)
-     | XO p -> Npos (Coq_Pos.size p)
-     | XH -> N0)
-  
-  (** val size : n -> n **)
-  
-  let size = function
-  | N0 -> N0
-  | Npos p -> Npos (Coq_Pos.size p)
-  
-  (** val size_nat : n -> nat **)
-  
-  let size_nat = function
-  | N0 -> O
-  | Npos p -> Coq_Pos.size_nat p
-  
-  (** val pos_div_eucl : positive -> n -> n * n **)
-  
-  let rec pos_div_eucl a b =
-    match a with
-    | XI a' ->
-      let q0,r = pos_div_eucl a' b in
-      let r' = succ_double r in
-      if leb b r' then (succ_double q0),(sub r' b) else (double q0),r'
-    | XO a' ->
-      let q0,r = pos_div_eucl a' b in
-      let r' = double r in
-      if leb b r' then (succ_double q0),(sub r' b) else (double q0),r'
-    | XH ->
-      (match b with
-       | N0 -> N0,(Npos XH)
-       | Npos p ->
-         (match p with
-          | XH -> (Npos XH),N0
-          | _ -> N0,(Npos XH)))
-  
-  (** val div_eucl : n -> n -> n * n **)
-  
-  let div_eucl a b =
-    match a with
-    | N0 -> N0,N0
-    | Npos na ->
-      (match b with
-       | N0 -> N0,a
-       | Npos p -> pos_div_eucl na b)
-  
-  (** val div : n -> n -> n **)
-  
-  let div a b =
-    fst (div_eucl a b)
-  
-  (** val modulo : n -> n -> n **)
-  
-  let modulo a b =
-    snd (div_eucl a b)
-  
-  (** val gcd : n -> n -> n **)
-  
-  let gcd a b =
-    match a with
-    | N0 -> b
-    | Npos p ->
-      (match b with
-       | N0 -> a
-       | Npos q0 -> Npos (Coq_Pos.gcd p q0))
-  
-  (** val ggcd : n -> n -> n * (n * n) **)
-  
-  let ggcd a b =
-    match a with
-    | N0 -> b,(N0,(Npos XH))
-    | Npos p ->
-      (match b with
-       | N0 -> a,((Npos XH),N0)
-       | Npos q0 ->
-         let g,p2 = Coq_Pos.ggcd p q0 in
-         let aa,bb = p2 in (Npos g),((Npos aa),(Npos bb)))
-  
-  (** val sqrtrem : n -> n * n **)
-  
-  let sqrtrem = function
-  | N0 -> N0,N0
-  | Npos p ->
-    let s,m = Coq_Pos.sqrtrem p in
-    (match m with
-     | Coq_Pos.IsPos r -> (Npos s),(Npos r)
-     | _ -> (Npos s),N0)
-  
-  (** val sqrt : n -> n **)
-  
-  let sqrt = function
-  | N0 -> N0
-  | Npos p -> Npos (Coq_Pos.sqrt p)
-  
-  (** val coq_lor : n -> n -> n **)
-  
-  let coq_lor n0 m =
-    match n0 with
-    | N0 -> m
-    | Npos p ->
-      (match m with
-       | N0 -> n0
-       | Npos q0 -> Npos (Coq_Pos.coq_lor p q0))
-  
-  (** val coq_land : n -> n -> n **)
-  
-  let coq_land n0 m =
-    match n0 with
-    | N0 -> N0
-    | Npos p ->
-      (match m with
-       | N0 -> N0
-       | Npos q0 -> Coq_Pos.coq_land p q0)
-  
-  (** val ldiff : n -> n -> n **)
-  
-  let ldiff n0 m =
-    match n0 with
-    | N0 -> N0
-    | Npos p ->
-      (match m with
-       | N0 -> n0
-       | Npos q0 -> Coq_Pos.ldiff p q0)
-  
-  (** val coq_lxor : n -> n -> n **)
-  
-  let coq_lxor n0 m =
-    match n0 with
-    | N0 -> m
-    | Npos p ->
-      (match m with
-       | N0 -> n0
-       | Npos q0 -> Coq_Pos.coq_lxor p q0)
-  
-  (** val shiftl_nat : n -> nat -> n **)
-  
-  let shiftl_nat a n0 =
-    nat_iter n0 double a
-  
-  (** val shiftr_nat : n -> nat -> n **)
-  
-  let shiftr_nat a n0 =
-    nat_iter n0 div2 a
-  
-  (** val shiftl : n -> n -> n **)
-  
-  let shiftl a n0 =
-    match a with
-    | N0 -> N0
-    | Npos a0 -> Npos (Coq_Pos.shiftl a0 n0)
-  
-  (** val shiftr : n -> n -> n **)
-  
-  let shiftr a = function
-  | N0 -> a
-  | Npos p -> Coq_Pos.iter p div2 a
-  
-  (** val testbit_nat : n -> nat -> bool **)
-  
-  let testbit_nat = function
-  | N0 -> (fun x -> false)
-  | Npos p -> Coq_Pos.testbit_nat p
-  
-  (** val testbit : n -> n -> bool **)
-  
-  let testbit a n0 =
-    match a with
-    | N0 -> false
-    | Npos p -> Coq_Pos.testbit p n0
-  
-  (** val to_nat : n -> nat **)
-  
-  let to_nat = function
-  | N0 -> O
-  | Npos p -> Coq_Pos.to_nat p
-  
+module N =
+ struct
   (** val of_nat : nat -> n **)
-  
+
   let of_nat = function
   | O -> N0
   | S n' -> Npos (Coq_Pos.of_succ_nat n')
-  
-  (** val iter : n -> ('a1 -> 'a1) -> 'a1 -> 'a1 **)
-  
-  let iter n0 f x =
-    match n0 with
-    | N0 -> x
-    | Npos p -> Coq_Pos.iter p f x
-  
-  (** val eq_dec : n -> n -> bool **)
-  
-  let eq_dec n0 m =
-    match n0 with
-    | N0 ->
-      (match m with
-       | N0 -> true
-       | Npos p -> false)
-    | Npos x ->
-      (match m with
-       | N0 -> false
-       | Npos p2 -> Coq_Pos.eq_dec x p2)
-  
-  (** val discr : n -> positive option **)
-  
-  let discr = function
-  | N0 -> None
-  | Npos p -> Some p
-  
-  (** val binary_rect :
-      'a1 -> (n -> 'a1 -> 'a1) -> (n -> 'a1 -> 'a1) -> n -> 'a1 **)
-  
-  let binary_rect f0 f2 fS2 n0 =
-    let f2' = fun p -> f2 (Npos p) in
-    let fS2' = fun p -> fS2 (Npos p) in
-    (match n0 with
-     | N0 -> f0
-     | Npos p ->
-       let rec f = function
-       | XI p3 -> fS2' p3 (f p3)
-       | XO p3 -> f2' p3 (f p3)
-       | XH -> fS2 N0 f0
-       in f p)
-  
-  (** val binary_rec :
-      'a1 -> (n -> 'a1 -> 'a1) -> (n -> 'a1 -> 'a1) -> n -> 'a1 **)
-  
-  let binary_rec =
-    binary_rect
-  
-  (** val peano_rect : 'a1 -> (n -> 'a1 -> 'a1) -> n -> 'a1 **)
-  
-  let peano_rect f0 f n0 =
-    let f' = fun p -> f (Npos p) in
-    (match n0 with
-     | N0 -> f0
-     | Npos p -> Coq_Pos.peano_rect (f N0 f0) f' p)
-  
-  (** val peano_rec : 'a1 -> (n -> 'a1 -> 'a1) -> n -> 'a1 **)
-  
-  let peano_rec =
-    peano_rect
-  
-  module BootStrap = 
-   struct 
-    
-   end
-  
-  (** val recursion : 'a1 -> (n -> 'a1 -> 'a1) -> n -> 'a1 **)
-  
-  let recursion x =
-    peano_rect x
-  
-  module OrderElts = 
-   struct 
-    type t = n
-   end
-  
-  module OrderTac = MakeOrderTac(OrderElts)
-  
-  module NZPowP = 
-   struct 
-    
-   end
-  
-  module NZSqrtP = 
-   struct 
-    
-   end
-  
-  (** val sqrt_up : n -> n **)
-  
-  let sqrt_up a =
-    match compare N0 a with
-    | Lt -> succ (sqrt (pred a))
-    | _ -> N0
-  
-  (** val log2_up : n -> n **)
-  
-  let log2_up a =
-    match compare (Npos XH) a with
-    | Lt -> succ (log2 (pred a))
-    | _ -> N0
-  
-  module NZDivP = 
-   struct 
-    
-   end
-  
-  (** val lcm : n -> n -> n **)
-  
-  let lcm a b =
-    mul a (div b (gcd a b))
-  
-  (** val b2n : bool -> n **)
-  
-  let b2n = function
-  | true -> Npos XH
-  | false -> N0
-  
-  (** val setbit : n -> n -> n **)
-  
-  let setbit a n0 =
-    coq_lor a (shiftl (Npos XH) n0)
-  
-  (** val clearbit : n -> n -> n **)
-  
-  let clearbit a n0 =
-    ldiff a (shiftl (Npos XH) n0)
-  
-  (** val ones : n -> n **)
-  
-  let ones n0 =
-    pred (shiftl (Npos XH) n0)
-  
-  (** val lnot : n -> n -> n **)
-  
-  let lnot a n0 =
-    coq_lxor a (ones n0)
-  
-  module T = 
-   struct 
-    
-   end
-  
-  module ORev = 
-   struct 
-    type t = n
-   end
-  
-  module MRev = 
-   struct 
-    (** val max : n -> n -> n **)
-    
-    let max x y =
-      min y x
-   end
-  
-  module MPRev = MaxLogicalProperties(ORev)(MRev)
-  
-  module P = 
-   struct 
-    (** val max_case_strong :
-        n -> n -> (n -> n -> __ -> 'a1 -> 'a1) -> (__ -> 'a1) -> (__ -> 'a1)
-        -> 'a1 **)
-    
-    let max_case_strong n0 m compat hl hr =
-      let c = compSpec2Type n0 m (compare n0 m) in
-      (match c with
-       | CompGtT -> compat n0 (max n0 m) __ (hl __)
-       | _ -> compat m (max n0 m) __ (hr __))
-    
-    (** val max_case :
-        n -> n -> (n -> n -> __ -> 'a1 -> 'a1) -> 'a1 -> 'a1 -> 'a1 **)
-    
-    let max_case n0 m x x0 x1 =
-      max_case_strong n0 m x (fun _ -> x0) (fun _ -> x1)
-    
-    (** val max_dec : n -> n -> bool **)
-    
-    let max_dec n0 m =
-      max_case n0 m (fun x y _ h0 -> h0) true false
-    
-    (** val min_case_strong :
-        n -> n -> (n -> n -> __ -> 'a1 -> 'a1) -> (__ -> 'a1) -> (__ -> 'a1)
-        -> 'a1 **)
-    
-    let min_case_strong n0 m compat hl hr =
-      let c = compSpec2Type n0 m (compare n0 m) in
-      (match c with
-       | CompGtT -> compat m (min n0 m) __ (hr __)
-       | _ -> compat n0 (min n0 m) __ (hl __))
-    
-    (** val min_case :
-        n -> n -> (n -> n -> __ -> 'a1 -> 'a1) -> 'a1 -> 'a1 -> 'a1 **)
-    
-    let min_case n0 m x x0 x1 =
-      min_case_strong n0 m x (fun _ -> x0) (fun _ -> x1)
-    
-    (** val min_dec : n -> n -> bool **)
-    
-    let min_dec n0 m =
-      min_case n0 m (fun x y _ h0 -> h0) true false
-   end
-  
-  (** val max_case_strong : n -> n -> (__ -> 'a1) -> (__ -> 'a1) -> 'a1 **)
-  
-  let max_case_strong n0 m x x0 =
-    P.max_case_strong n0 m (fun x1 y _ x2 -> x2) x x0
-  
-  (** val max_case : n -> n -> 'a1 -> 'a1 -> 'a1 **)
-  
-  let max_case n0 m x x0 =
-    max_case_strong n0 m (fun _ -> x) (fun _ -> x0)
-  
-  (** val max_dec : n -> n -> bool **)
-  
-  let max_dec =
-    P.max_dec
-  
-  (** val min_case_strong : n -> n -> (__ -> 'a1) -> (__ -> 'a1) -> 'a1 **)
-  
-  let min_case_strong n0 m x x0 =
-    P.min_case_strong n0 m (fun x1 y _ x2 -> x2) x x0
-  
-  (** val min_case : n -> n -> 'a1 -> 'a1 -> 'a1 **)
-  
-  let min_case n0 m x x0 =
-    min_case_strong n0 m (fun _ -> x) (fun _ -> x0)
-  
-  (** val min_dec : n -> n -> bool **)
-  
-  let min_dec =
-    P.min_dec
  end
 
 (** val pow_pos : ('a1 -> 'a1 -> 'a1) -> 'a1 -> positive -> 'a1 **)
@@ -2006,66 +280,49 @@ let rec nth n0 l default =
   | O ->
     (match l with
      | [] -> default
-     | x::l' -> x)
+     | x::_ -> x)
   | S m ->
     (match l with
      | [] -> default
-     | x::t1 -> nth m t1 default)
+     | _::t0 -> nth m t0 default)
 
 (** val map : ('a1 -> 'a2) -> 'a1 list -> 'a2 list **)
 
 let rec map f = function
 | [] -> []
-| a::t1 -> (f a)::(map f t1)
+| a::t0 -> (f a)::(map f t0)
 
 (** val fold_right : ('a2 -> 'a1 -> 'a1) -> 'a1 -> 'a2 list -> 'a1 **)
 
 let rec fold_right f a0 = function
 | [] -> a0
-| b::t1 -> f b (fold_right f a0 t1)
-
-module Z = 
- struct 
-  type t = z
-  
-  (** val zero : z **)
-  
-  let zero =
-    Z0
-  
-  (** val one : z **)
-  
-  let one =
-    Zpos XH
-  
-  (** val two : z **)
-  
-  let two =
-    Zpos (XO XH)
-  
+| b::t0 -> f b (fold_right f a0 t0)
+
+module Z =
+ struct
   (** val double : z -> z **)
-  
+
   let double = function
   | Z0 -> Z0
   | Zpos p -> Zpos (XO p)
   | Zneg p -> Zneg (XO p)
-  
+
   (** val succ_double : z -> z **)
-  
+
   let succ_double = function
   | Z0 -> Zpos XH
   | Zpos p -> Zpos (XI p)
   | Zneg p -> Zneg (Coq_Pos.pred_double p)
-  
+
   (** val pred_double : z -> z **)
-  
+
   let pred_double = function
   | Z0 -> Zneg XH
   | Zpos p -> Zpos (Coq_Pos.pred_double p)
   | Zneg p -> Zneg (XI p)
-  
+
   (** val pos_sub : positive -> positive -> z **)
-  
+
   let rec pos_sub x y =
     match x with
     | XI p ->
@@ -2083,9 +340,9 @@ module Z =
        | XI q0 -> Zneg (XO q0)
        | XO q0 -> Zneg (Coq_Pos.pred_double q0)
        | XH -> Z0)
-  
+
   (** val add : z -> z -> z **)
-  
+
   let add x y =
     match x with
     | Z0 -> y
@@ -2099,31 +356,21 @@ module Z =
        | Z0 -> x
        | Zpos y' -> pos_sub y' x'
        | Zneg y' -> Zneg (Coq_Pos.add x' y'))
-  
+
   (** val opp : z -> z **)
-  
+
   let opp = function
   | Z0 -> Z0
   | Zpos x0 -> Zneg x0
   | Zneg x0 -> Zpos x0
-  
-  (** val succ : z -> z **)
-  
-  let succ x =
-    add x (Zpos XH)
-  
-  (** val pred : z -> z **)
-  
-  let pred x =
-    add x (Zneg XH)
-  
+
   (** val sub : z -> z -> z **)
-  
+
   let sub m n0 =
     add m (opp n0)
-  
+
   (** val mul : z -> z -> z **)
-  
+
   let mul x y =
     match x with
     | Z0 -> Z0
@@ -2137,28 +384,16 @@ module Z =
        | Z0 -> Z0
        | Zpos y' -> Zneg (Coq_Pos.mul x' y')
        | Zneg y' -> Zpos (Coq_Pos.mul x' y'))
-  
-  (** val pow_pos : z -> positive -> z **)
-  
-  let pow_pos z0 n0 =
-    Coq_Pos.iter n0 (mul z0) (Zpos XH)
-  
-  (** val pow : z -> z -> z **)
-  
-  let pow x = function
-  | Z0 -> Zpos XH
-  | Zpos p -> pow_pos x p
-  | Zneg p -> Z0
-  
+
   (** val compare : z -> z -> comparison **)
-  
+
   let compare x y =
     match x with
     | Z0 ->
       (match y with
        | Z0 -> Eq
-       | Zpos y' -> Lt
-       | Zneg y' -> Gt)
+       | Zpos _ -> Lt
+       | Zneg _ -> Gt)
     | Zpos x' ->
       (match y with
        | Zpos y' -> Coq_Pos.compare x' y'
@@ -2167,151 +402,74 @@ module Z =
       (match y with
        | Zneg y' -> compOpp (Coq_Pos.compare x' y')
        | _ -> Lt)
-  
-  (** val sgn : z -> z **)
-  
-  let sgn = function
-  | Z0 -> Z0
-  | Zpos p -> Zpos XH
-  | Zneg p -> Zneg XH
-  
+
   (** val leb : z -> z -> bool **)
-  
+
   let leb x y =
     match compare x y with
     | Gt -> false
     | _ -> true
-  
-  (** val geb : z -> z -> bool **)
-  
-  let geb x y =
-    match compare x y with
-    | Lt -> false
-    | _ -> true
-  
+
   (** val ltb : z -> z -> bool **)
-  
+
   let ltb x y =
     match compare x y with
     | Lt -> true
     | _ -> false
-  
+
   (** val gtb : z -> z -> bool **)
-  
+
   let gtb x y =
     match compare x y with
     | Gt -> true
     | _ -> false
-  
-  (** val eqb : z -> z -> bool **)
-  
-  let eqb x y =
-    match x with
-    | Z0 ->
-      (match y with
-       | Z0 -> true
-       | _ -> false)
-    | Zpos p ->
-      (match y with
-       | Zpos q0 -> Coq_Pos.eqb p q0
-       | _ -> false)
-    | Zneg p ->
-      (match y with
-       | Zneg q0 -> Coq_Pos.eqb p q0
-       | _ -> false)
-  
+
   (** val max : z -> z -> z **)
-  
+
   let max n0 m =
     match compare n0 m with
     | Lt -> m
     | _ -> n0
-  
-  (** val min : z -> z -> z **)
-  
-  let min n0 m =
-    match compare n0 m with
-    | Gt -> m
-    | _ -> n0
-  
+
   (** val abs : z -> z **)
-  
+
   let abs = function
   | Zneg p -> Zpos p
   | x -> x
-  
-  (** val abs_nat : z -> nat **)
-  
-  let abs_nat = function
-  | Z0 -> O
-  | Zpos p -> Coq_Pos.to_nat p
-  | Zneg p -> Coq_Pos.to_nat p
-  
-  (** val abs_N : z -> n **)
-  
-  let abs_N = function
-  | Z0 -> N0
-  | Zpos p -> Npos p
-  | Zneg p -> Npos p
-  
-  (** val to_nat : z -> nat **)
-  
-  let to_nat = function
-  | Zpos p -> Coq_Pos.to_nat p
-  | _ -> O
-  
+
   (** val to_N : z -> n **)
-  
+
   let to_N = function
   | Zpos p -> Npos p
   | _ -> N0
-  
-  (** val of_nat : nat -> z **)
-  
-  let of_nat = function
-  | O -> Z0
-  | S n1 -> Zpos (Coq_Pos.of_succ_nat n1)
-  
-  (** val of_N : n -> z **)
-  
-  let of_N = function
-  | N0 -> Z0
-  | Npos p -> Zpos p
-  
-  (** val iter : z -> ('a1 -> 'a1) -> 'a1 -> 'a1 **)
-  
-  let iter n0 f x =
-    match n0 with
-    | Zpos p -> Coq_Pos.iter p f x
-    | _ -> x
-  
+
   (** val pos_div_eucl : positive -> z -> z * z **)
-  
+
   let rec pos_div_eucl a b =
     match a with
     | XI a' ->
       let q0,r = pos_div_eucl a' b in
       let r' = add (mul (Zpos (XO XH)) r) (Zpos XH) in
-      if gtb b r'
+      if ltb r' b
       then (mul (Zpos (XO XH)) q0),r'
       else (add (mul (Zpos (XO XH)) q0) (Zpos XH)),(sub r' b)
     | XO a' ->
       let q0,r = pos_div_eucl a' b in
       let r' = mul (Zpos (XO XH)) r in
-      if gtb b r'
+      if ltb r' b
       then (mul (Zpos (XO XH)) q0),r'
       else (add (mul (Zpos (XO XH)) q0) (Zpos XH)),(sub r' b)
-    | XH -> if geb b (Zpos (XO XH)) then Z0,(Zpos XH) else (Zpos XH),Z0
-  
+    | XH -> if leb (Zpos (XO XH)) b then Z0,(Zpos XH) else (Zpos XH),Z0
+
   (** val div_eucl : z -> z -> z * z **)
-  
+
   let div_eucl a b =
     match a with
     | Z0 -> Z0,Z0
     | Zpos a' ->
       (match b with
        | Z0 -> Z0,Z0
-       | Zpos p -> pos_div_eucl a' b
+       | Zpos _ -> pos_div_eucl a' b
        | Zneg b' ->
          let q0,r = pos_div_eucl a' (Zpos b') in
          (match r with
@@ -2320,131 +478,20 @@ module Z =
     | Zneg a' ->
       (match b with
        | Z0 -> Z0,Z0
-       | Zpos p ->
+       | Zpos _ ->
          let q0,r = pos_div_eucl a' b in
          (match r with
           | Z0 -> (opp q0),Z0
           | _ -> (opp (add q0 (Zpos XH))),(sub b r))
        | Zneg b' -> let q0,r = pos_div_eucl a' (Zpos b') in q0,(opp r))
-  
+
   (** val div : z -> z -> z **)
-  
+
   let div a b =
-    let q0,x = div_eucl a b in q0
-  
-  (** val modulo : z -> z -> z **)
-  
-  let modulo a b =
-    let x,r = div_eucl a b in r
-  
-  (** val quotrem : z -> z -> z * z **)
-  
-  let quotrem a b =
-    match a with
-    | Z0 -> Z0,Z0
-    | Zpos a0 ->
-      (match b with
-       | Z0 -> Z0,a
-       | Zpos b0 ->
-         let q0,r = N.pos_div_eucl a0 (Npos b0) in (of_N q0),(of_N r)
-       | Zneg b0 ->
-         let q0,r = N.pos_div_eucl a0 (Npos b0) in (opp (of_N q0)),(of_N r))
-    | Zneg a0 ->
-      (match b with
-       | Z0 -> Z0,a
-       | Zpos b0 ->
-         let q0,r = N.pos_div_eucl a0 (Npos b0) in
-         (opp (of_N q0)),(opp (of_N r))
-       | Zneg b0 ->
-         let q0,r = N.pos_div_eucl a0 (Npos b0) in (of_N q0),(opp (of_N r)))
-  
-  (** val quot : z -> z -> z **)
-  
-  let quot a b =
-    fst (quotrem a b)
-  
-  (** val rem : z -> z -> z **)
-  
-  let rem a b =
-    snd (quotrem a b)
-  
-  (** val even : z -> bool **)
-  
-  let even = function
-  | Z0 -> true
-  | Zpos p ->
-    (match p with
-     | XO p2 -> true
-     | _ -> false)
-  | Zneg p ->
-    (match p with
-     | XO p2 -> true
-     | _ -> false)
-  
-  (** val odd : z -> bool **)
-  
-  let odd = function
-  | Z0 -> false
-  | Zpos p ->
-    (match p with
-     | XO p2 -> false
-     | _ -> true)
-  | Zneg p ->
-    (match p with
-     | XO p2 -> false
-     | _ -> true)
-  
-  (** val div2 : z -> z **)
-  
-  let div2 = function
-  | Z0 -> Z0
-  | Zpos p ->
-    (match p with
-     | XH -> Z0
-     | _ -> Zpos (Coq_Pos.div2 p))
-  | Zneg p -> Zneg (Coq_Pos.div2_up p)
-  
-  (** val quot2 : z -> z **)
-  
-  let quot2 = function
-  | Z0 -> Z0
-  | Zpos p ->
-    (match p with
-     | XH -> Z0
-     | _ -> Zpos (Coq_Pos.div2 p))
-  | Zneg p ->
-    (match p with
-     | XH -> Z0
-     | _ -> Zneg (Coq_Pos.div2 p))
-  
-  (** val log2 : z -> z **)
-  
-  let log2 = function
-  | Zpos p2 ->
-    (match p2 with
-     | XI p -> Zpos (Coq_Pos.size p)
-     | XO p -> Zpos (Coq_Pos.size p)
-     | XH -> Z0)
-  | _ -> Z0
-  
-  (** val sqrtrem : z -> z * z **)
-  
-  let sqrtrem = function
-  | Zpos p ->
-    let s,m = Coq_Pos.sqrtrem p in
-    (match m with
-     | Coq_Pos.IsPos r -> (Zpos s),(Zpos r)
-     | _ -> (Zpos s),Z0)
-  | _ -> Z0,Z0
-  
-  (** val sqrt : z -> z **)
-  
-  let sqrt = function
-  | Zpos p -> Zpos (Coq_Pos.sqrt p)
-  | _ -> Z0
-  
+    let q0,_ = div_eucl a b in q0
+
   (** val gcd : z -> z -> z **)
-  
+
   let gcd a b =
     match a with
     | Z0 -> abs b
@@ -2458,316 +505,6 @@ module Z =
        | Z0 -> abs a
        | Zpos b0 -> Zpos (Coq_Pos.gcd a0 b0)
        | Zneg b0 -> Zpos (Coq_Pos.gcd a0 b0))
-  
-  (** val ggcd : z -> z -> z * (z * z) **)
-  
-  let ggcd a b =
-    match a with
-    | Z0 -> (abs b),(Z0,(sgn b))
-    | Zpos a0 ->
-      (match b with
-       | Z0 -> (abs a),((sgn a),Z0)
-       | Zpos b0 ->
-         let g,p = Coq_Pos.ggcd a0 b0 in
-         let aa,bb = p in (Zpos g),((Zpos aa),(Zpos bb))
-       | Zneg b0 ->
-         let g,p = Coq_Pos.ggcd a0 b0 in
-         let aa,bb = p in (Zpos g),((Zpos aa),(Zneg bb)))
-    | Zneg a0 ->
-      (match b with
-       | Z0 -> (abs a),((sgn a),Z0)
-       | Zpos b0 ->
-         let g,p = Coq_Pos.ggcd a0 b0 in
-         let aa,bb = p in (Zpos g),((Zneg aa),(Zpos bb))
-       | Zneg b0 ->
-         let g,p = Coq_Pos.ggcd a0 b0 in
-         let aa,bb = p in (Zpos g),((Zneg aa),(Zneg bb)))
-  
-  (** val testbit : z -> z -> bool **)
-  
-  let testbit a = function
-  | Z0 -> odd a
-  | Zpos p ->
-    (match a with
-     | Z0 -> false
-     | Zpos a0 -> Coq_Pos.testbit a0 (Npos p)
-     | Zneg a0 -> negb (N.testbit (Coq_Pos.pred_N a0) (Npos p)))
-  | Zneg p -> false
-  
-  (** val shiftl : z -> z -> z **)
-  
-  let shiftl a = function
-  | Z0 -> a
-  | Zpos p -> Coq_Pos.iter p (mul (Zpos (XO XH))) a
-  | Zneg p -> Coq_Pos.iter p div2 a
-  
-  (** val shiftr : z -> z -> z **)
-  
-  let shiftr a n0 =
-    shiftl a (opp n0)
-  
-  (** val coq_lor : z -> z -> z **)
-  
-  let coq_lor a b =
-    match a with
-    | Z0 -> b
-    | Zpos a0 ->
-      (match b with
-       | Z0 -> a
-       | Zpos b0 -> Zpos (Coq_Pos.coq_lor a0 b0)
-       | Zneg b0 -> Zneg (N.succ_pos (N.ldiff (Coq_Pos.pred_N b0) (Npos a0))))
-    | Zneg a0 ->
-      (match b with
-       | Z0 -> a
-       | Zpos b0 -> Zneg (N.succ_pos (N.ldiff (Coq_Pos.pred_N a0) (Npos b0)))
-       | Zneg b0 ->
-         Zneg
-           (N.succ_pos (N.coq_land (Coq_Pos.pred_N a0) (Coq_Pos.pred_N b0))))
-  
-  (** val coq_land : z -> z -> z **)
-  
-  let coq_land a b =
-    match a with
-    | Z0 -> Z0
-    | Zpos a0 ->
-      (match b with
-       | Z0 -> Z0
-       | Zpos b0 -> of_N (Coq_Pos.coq_land a0 b0)
-       | Zneg b0 -> of_N (N.ldiff (Npos a0) (Coq_Pos.pred_N b0)))
-    | Zneg a0 ->
-      (match b with
-       | Z0 -> Z0
-       | Zpos b0 -> of_N (N.ldiff (Npos b0) (Coq_Pos.pred_N a0))
-       | Zneg b0 ->
-         Zneg
-           (N.succ_pos (N.coq_lor (Coq_Pos.pred_N a0) (Coq_Pos.pred_N b0))))
-  
-  (** val ldiff : z -> z -> z **)
-  
-  let ldiff a b =
-    match a with
-    | Z0 -> Z0
-    | Zpos a0 ->
-      (match b with
-       | Z0 -> a
-       | Zpos b0 -> of_N (Coq_Pos.ldiff a0 b0)
-       | Zneg b0 -> of_N (N.coq_land (Npos a0) (Coq_Pos.pred_N b0)))
-    | Zneg a0 ->
-      (match b with
-       | Z0 -> a
-       | Zpos b0 ->
-         Zneg (N.succ_pos (N.coq_lor (Coq_Pos.pred_N a0) (Npos b0)))
-       | Zneg b0 -> of_N (N.ldiff (Coq_Pos.pred_N b0) (Coq_Pos.pred_N a0)))
-  
-  (** val coq_lxor : z -> z -> z **)
-  
-  let coq_lxor a b =
-    match a with
-    | Z0 -> b
-    | Zpos a0 ->
-      (match b with
-       | Z0 -> a
-       | Zpos b0 -> of_N (Coq_Pos.coq_lxor a0 b0)
-       | Zneg b0 ->
-         Zneg (N.succ_pos (N.coq_lxor (Npos a0) (Coq_Pos.pred_N b0))))
-    | Zneg a0 ->
-      (match b with
-       | Z0 -> a
-       | Zpos b0 ->
-         Zneg (N.succ_pos (N.coq_lxor (Coq_Pos.pred_N a0) (Npos b0)))
-       | Zneg b0 -> of_N (N.coq_lxor (Coq_Pos.pred_N a0) (Coq_Pos.pred_N b0)))
-  
-  (** val eq_dec : z -> z -> bool **)
-  
-  let eq_dec x y =
-    match x with
-    | Z0 ->
-      (match y with
-       | Z0 -> true
-       | _ -> false)
-    | Zpos x0 ->
-      (match y with
-       | Zpos p2 -> Coq_Pos.eq_dec x0 p2
-       | _ -> false)
-    | Zneg x0 ->
-      (match y with
-       | Zneg p2 -> Coq_Pos.eq_dec x0 p2
-       | _ -> false)
-  
-  module BootStrap = 
-   struct 
-    
-   end
-  
-  module OrderElts = 
-   struct 
-    type t = z
-   end
-  
-  module OrderTac = MakeOrderTac(OrderElts)
-  
-  (** val sqrt_up : z -> z **)
-  
-  let sqrt_up a =
-    match compare Z0 a with
-    | Lt -> succ (sqrt (pred a))
-    | _ -> Z0
-  
-  (** val log2_up : z -> z **)
-  
-  let log2_up a =
-    match compare (Zpos XH) a with
-    | Lt -> succ (log2 (pred a))
-    | _ -> Z0
-  
-  module NZDivP = 
-   struct 
-    
-   end
-  
-  module Quot2Div = 
-   struct 
-    (** val div : z -> z -> z **)
-    
-    let div =
-      quot
-    
-    (** val modulo : z -> z -> z **)
-    
-    let modulo =
-      rem
-   end
-  
-  module NZQuot = 
-   struct 
-    
-   end
-  
-  (** val lcm : z -> z -> z **)
-  
-  let lcm a b =
-    abs (mul a (div b (gcd a b)))
-  
-  (** val b2z : bool -> z **)
-  
-  let b2z = function
-  | true -> Zpos XH
-  | false -> Z0
-  
-  (** val setbit : z -> z -> z **)
-  
-  let setbit a n0 =
-    coq_lor a (shiftl (Zpos XH) n0)
-  
-  (** val clearbit : z -> z -> z **)
-  
-  let clearbit a n0 =
-    ldiff a (shiftl (Zpos XH) n0)
-  
-  (** val lnot : z -> z **)
-  
-  let lnot a =
-    pred (opp a)
-  
-  (** val ones : z -> z **)
-  
-  let ones n0 =
-    pred (shiftl (Zpos XH) n0)
-  
-  module T = 
-   struct 
-    
-   end
-  
-  module ORev = 
-   struct 
-    type t = z
-   end
-  
-  module MRev = 
-   struct 
-    (** val max : z -> z -> z **)
-    
-    let max x y =
-      min y x
-   end
-  
-  module MPRev = MaxLogicalProperties(ORev)(MRev)
-  
-  module P = 
-   struct 
-    (** val max_case_strong :
-        z -> z -> (z -> z -> __ -> 'a1 -> 'a1) -> (__ -> 'a1) -> (__ -> 'a1)
-        -> 'a1 **)
-    
-    let max_case_strong n0 m compat hl hr =
-      let c = compSpec2Type n0 m (compare n0 m) in
-      (match c with
-       | CompGtT -> compat n0 (max n0 m) __ (hl __)
-       | _ -> compat m (max n0 m) __ (hr __))
-    
-    (** val max_case :
-        z -> z -> (z -> z -> __ -> 'a1 -> 'a1) -> 'a1 -> 'a1 -> 'a1 **)
-    
-    let max_case n0 m x x0 x1 =
-      max_case_strong n0 m x (fun _ -> x0) (fun _ -> x1)
-    
-    (** val max_dec : z -> z -> bool **)
-    
-    let max_dec n0 m =
-      max_case n0 m (fun x y _ h0 -> h0) true false
-    
-    (** val min_case_strong :
-        z -> z -> (z -> z -> __ -> 'a1 -> 'a1) -> (__ -> 'a1) -> (__ -> 'a1)
-        -> 'a1 **)
-    
-    let min_case_strong n0 m compat hl hr =
-      let c = compSpec2Type n0 m (compare n0 m) in
-      (match c with
-       | CompGtT -> compat m (min n0 m) __ (hr __)
-       | _ -> compat n0 (min n0 m) __ (hl __))
-    
-    (** val min_case :
-        z -> z -> (z -> z -> __ -> 'a1 -> 'a1) -> 'a1 -> 'a1 -> 'a1 **)
-    
-    let min_case n0 m x x0 x1 =
-      min_case_strong n0 m x (fun _ -> x0) (fun _ -> x1)
-    
-    (** val min_dec : z -> z -> bool **)
-    
-    let min_dec n0 m =
-      min_case n0 m (fun x y _ h0 -> h0) true false
-   end
-  
-  (** val max_case_strong : z -> z -> (__ -> 'a1) -> (__ -> 'a1) -> 'a1 **)
-  
-  let max_case_strong n0 m x x0 =
-    P.max_case_strong n0 m (fun x1 y _ x2 -> x2) x x0
-  
-  (** val max_case : z -> z -> 'a1 -> 'a1 -> 'a1 **)
-  
-  let max_case n0 m x x0 =
-    max_case_strong n0 m (fun _ -> x) (fun _ -> x0)
-  
-  (** val max_dec : z -> z -> bool **)
-  
-  let max_dec =
-    P.max_dec
-  
-  (** val min_case_strong : z -> z -> (__ -> 'a1) -> (__ -> 'a1) -> 'a1 **)
-  
-  let min_case_strong n0 m x x0 =
-    P.min_case_strong n0 m (fun x1 y _ x2 -> x2) x x0
-  
-  (** val min_case : z -> z -> 'a1 -> 'a1 -> 'a1 **)
-  
-  let min_case n0 m x x0 =
-    min_case_strong n0 m (fun _ -> x) (fun _ -> x0)
-  
-  (** val min_dec : z -> z -> bool **)
-  
-  let min_dec =
-    P.min_dec
  end
 
 (** val zeq_bool : z -> z -> bool **)
@@ -2818,9 +555,9 @@ let rec peq ceqb p p' =
 (** val mkPinj : positive -> 'a1 pol -> 'a1 pol **)
 
 let mkPinj j p = match p with
-| Pc c -> p
+| Pc _ -> p
 | Pinj (j', q0) -> Pinj ((Coq_Pos.add j j'), q0)
-| PX (p2, p3, p4) -> Pinj (j, p)
+| PX (_, _, _) -> Pinj (j, p)
 
 (** val mkPinj_pred : positive -> 'a1 pol -> 'a1 pol **)
 
@@ -2831,12 +568,13 @@ let mkPinj_pred j p =
   | XH -> p
 
 (** val mkPX :
-    'a1 -> ('a1 -> 'a1 -> bool) -> 'a1 pol -> positive -> 'a1 pol -> 'a1 pol **)
+    'a1 -> ('a1 -> 'a1 -> bool) -> 'a1 pol -> positive -> 'a1 pol -> 'a1
+    pol **)
 
 let mkPX cO ceqb p i q0 =
   match p with
   | Pc c -> if ceqb c cO then mkPinj XH q0 else PX (p, i, q0)
-  | Pinj (p2, p3) -> PX (p, i, q0)
+  | Pinj (_, _) -> PX (p, i, q0)
   | PX (p', i', q') ->
     if peq ceqb q' (p0 cO)
     then PX (p', (Coq_Pos.add i' i), q0)
@@ -2893,8 +631,8 @@ let rec paddI cadd pop q0 j = function
    | XH -> PX (p2, i, (pop q' q0)))
 
 (** val psubI :
-    ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1) -> ('a1 pol -> 'a1 pol -> 'a1 pol) ->
-    'a1 pol -> positive -> 'a1 pol -> 'a1 pol **)
+    ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1) -> ('a1 pol -> 'a1 pol -> 'a1 pol)
+    -> 'a1 pol -> positive -> 'a1 pol -> 'a1 pol **)
 
 let rec psubI cadd copp pop q0 j = function
 | Pc c -> mkPinj j (paddC cadd (popp copp q0) c)
@@ -2911,11 +649,11 @@ let rec psubI cadd copp pop q0 j = function
    | XH -> PX (p2, i, (pop q' q0)))
 
 (** val paddX :
-    'a1 -> ('a1 -> 'a1 -> bool) -> ('a1 pol -> 'a1 pol -> 'a1 pol) -> 'a1 pol
-    -> positive -> 'a1 pol -> 'a1 pol **)
+    'a1 -> ('a1 -> 'a1 -> bool) -> ('a1 pol -> 'a1 pol -> 'a1 pol) -> 'a1
+    pol -> positive -> 'a1 pol -> 'a1 pol **)
 
 let rec paddX cO ceqb pop p' i' p = match p with
-| Pc c -> PX (p', i', p)
+| Pc _ -> PX (p', i', p)
 | Pinj (j, q') ->
   (match j with
    | XI j0 -> PX (p', i', (Pinj ((XO j0), q')))
@@ -2928,15 +666,16 @@ let rec paddX cO ceqb pop p' i' p = match p with
    | Zneg k -> mkPX cO ceqb (paddX cO ceqb pop p' k p2) i q')
 
 (** val psubX :
-    'a1 -> ('a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> ('a1 pol -> 'a1 pol -> 'a1
-    pol) -> 'a1 pol -> positive -> 'a1 pol -> 'a1 pol **)
+    'a1 -> ('a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> ('a1 pol -> 'a1 pol ->
+    'a1 pol) -> 'a1 pol -> positive -> 'a1 pol -> 'a1 pol **)
 
 let rec psubX cO copp ceqb pop p' i' p = match p with
-| Pc c -> PX ((popp copp p'), i', p)
+| Pc _ -> PX ((popp copp p'), i', p)
 | Pinj (j, q') ->
   (match j with
    | XI j0 -> PX ((popp copp p'), i', (Pinj ((XO j0), q')))
-   | XO j0 -> PX ((popp copp p'), i', (Pinj ((Coq_Pos.pred_double j0), q')))
+   | XO j0 ->
+     PX ((popp copp p'), i', (Pinj ((Coq_Pos.pred_double j0), q')))
    | XH -> PX ((popp copp p'), i', q'))
 | PX (p2, i, q') ->
   (match Z.pos_sub i i' with
@@ -2945,8 +684,8 @@ let rec psubX cO copp ceqb pop p' i' p = match p with
    | Zneg k -> mkPX cO ceqb (psubX cO copp ceqb pop p' k p2) i q')
 
 (** val padd :
-    'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 pol -> 'a1 pol
-    -> 'a1 pol **)
+    'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 pol -> 'a1
+    pol -> 'a1 pol **)
 
 let rec padd cO cadd ceqb p = function
 | Pc c' -> paddC cadd p c'
@@ -2964,7 +703,8 @@ let rec padd cO cadd ceqb p = function
    | PX (p2, i, q0) ->
      (match Z.pos_sub i i' with
       | Z0 ->
-        mkPX cO ceqb (padd cO cadd ceqb p2 p'0) i (padd cO cadd ceqb q0 q')
+        mkPX cO ceqb (padd cO cadd ceqb p2 p'0) i
+          (padd cO cadd ceqb q0 q')
       | Zpos k ->
         mkPX cO ceqb (padd cO cadd ceqb (PX (p2, k, (p0 cO))) p'0) i'
           (padd cO cadd ceqb q0 q')
@@ -2973,8 +713,8 @@ let rec padd cO cadd ceqb p = function
           (padd cO cadd ceqb q0 q')))
 
 (** val psub :
-    'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1) -> ('a1
-    -> 'a1 -> bool) -> 'a1 pol -> 'a1 pol -> 'a1 pol **)
+    'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1) ->
+    ('a1 -> 'a1 -> bool) -> 'a1 pol -> 'a1 pol -> 'a1 pol **)
 
 let rec psub cO cadd csub copp ceqb p = function
 | Pc c' -> psubC csub p c'
@@ -2989,25 +729,27 @@ let rec psub cO cadd csub copp ceqb p = function
           (psub cO cadd csub copp ceqb (Pinj ((XO j0), q0)) q'))
       | XO j0 ->
         PX ((popp copp p'0), i',
-          (psub cO cadd csub copp ceqb (Pinj ((Coq_Pos.pred_double j0), q0))
-            q'))
-      | XH -> PX ((popp copp p'0), i', (psub cO cadd csub copp ceqb q0 q')))
+          (psub cO cadd csub copp ceqb (Pinj ((Coq_Pos.pred_double j0),
+            q0)) q'))
+      | XH ->
+        PX ((popp copp p'0), i', (psub cO cadd csub copp ceqb q0 q')))
    | PX (p2, i, q0) ->
      (match Z.pos_sub i i' with
       | Z0 ->
         mkPX cO ceqb (psub cO cadd csub copp ceqb p2 p'0) i
           (psub cO cadd csub copp ceqb q0 q')
       | Zpos k ->
-        mkPX cO ceqb (psub cO cadd csub copp ceqb (PX (p2, k, (p0 cO))) p'0)
-          i' (psub cO cadd csub copp ceqb q0 q')
+        mkPX cO ceqb
+          (psub cO cadd csub copp ceqb (PX (p2, k, (p0 cO))) p'0) i'
+          (psub cO cadd csub copp ceqb q0 q')
       | Zneg k ->
         mkPX cO ceqb
           (psubX cO copp ceqb (psub cO cadd csub copp ceqb) p'0 k p2) i
           (psub cO cadd csub copp ceqb q0 q')))
 
 (** val pmulC_aux :
-    'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 pol -> 'a1 ->
-    'a1 pol **)
+    'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 pol -> 'a1
+    -> 'a1 pol **)
 
 let rec pmulC_aux cO cmul ceqb p c =
   match p with
@@ -3018,8 +760,8 @@ let rec pmulC_aux cO cmul ceqb p c =
       (pmulC_aux cO cmul ceqb q0 c)
 
 (** val pmulC :
-    'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 pol ->
-    'a1 -> 'a1 pol **)
+    'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 pol
+    -> 'a1 -> 'a1 pol **)
 
 let pmulC cO cI cmul ceqb p c =
   if ceqb c cO
@@ -3027,8 +769,8 @@ let pmulC cO cI cmul ceqb p c =
   else if ceqb c cI then p else pmulC_aux cO cmul ceqb p c
 
 (** val pmulI :
-    'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> ('a1 pol ->
-    'a1 pol -> 'a1 pol) -> 'a1 pol -> positive -> 'a1 pol -> 'a1 pol **)
+    'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> ('a1 pol
+    -> 'a1 pol -> 'a1 pol) -> 'a1 pol -> positive -> 'a1 pol -> 'a1 pol **)
 
 let rec pmulI cO cI cmul ceqb pmul0 q0 j = function
 | Pc c -> mkPinj j (pmulC cO cI cmul ceqb q0 c)
@@ -3049,12 +791,13 @@ let rec pmulI cO cI cmul ceqb pmul0 q0 j = function
      mkPX cO ceqb (pmulI cO cI cmul ceqb pmul0 q0 XH p') i' (pmul0 q' q0))
 
 (** val pmul :
-    'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1
-    -> bool) -> 'a1 pol -> 'a1 pol -> 'a1 pol **)
+    'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 ->
+    'a1 -> bool) -> 'a1 pol -> 'a1 pol -> 'a1 pol **)
 
 let rec pmul cO cI cadd cmul ceqb p p'' = match p'' with
 | Pc c -> pmulC cO cI cmul ceqb p c
-| Pinj (j', q') -> pmulI cO cI cmul ceqb (pmul cO cI cadd cmul ceqb) q' j' p
+| Pinj (j', q') ->
+  pmulI cO cI cmul ceqb (pmul cO cI cadd cmul ceqb) q' j' p
 | PX (p', i', q') ->
   (match p with
    | Pc c -> pmulC cO cI cmul ceqb p'' c
@@ -3063,22 +806,24 @@ let rec pmul cO cI cadd cmul ceqb p p'' = match p'' with
        match j with
        | XI j0 -> pmul cO cI cadd cmul ceqb (Pinj ((XO j0), q0)) q'
        | XO j0 ->
-         pmul cO cI cadd cmul ceqb (Pinj ((Coq_Pos.pred_double j0), q0)) q'
+         pmul cO cI cadd cmul ceqb (Pinj ((Coq_Pos.pred_double j0), q0))
+           q'
        | XH -> pmul cO cI cadd cmul ceqb q0 q'
      in
      mkPX cO ceqb (pmul cO cI cadd cmul ceqb p p') i' qQ'
    | PX (p2, i, q0) ->
      let qQ' = pmul cO cI cadd cmul ceqb q0 q' in
-     let pQ' = pmulI cO cI cmul ceqb (pmul cO cI cadd cmul ceqb) q' XH p2 in
+     let pQ' = pmulI cO cI cmul ceqb (pmul cO cI cadd cmul ceqb) q' XH p2
+     in
      let qP' = pmul cO cI cadd cmul ceqb (mkPinj XH q0) p' in
      let pP' = pmul cO cI cadd cmul ceqb p2 p' in
      padd cO cadd ceqb
-       (mkPX cO ceqb (padd cO cadd ceqb (mkPX cO ceqb pP' i (p0 cO)) qP') i'
-         (p0 cO)) (mkPX cO ceqb pQ' i qQ'))
+       (mkPX cO ceqb (padd cO cadd ceqb (mkPX cO ceqb pP' i (p0 cO)) qP')
+         i' (p0 cO)) (mkPX cO ceqb pQ' i qQ'))
 
 (** val psquare :
-    'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1
-    -> bool) -> 'a1 pol -> 'a1 pol **)
+    'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 ->
+    'a1 -> bool) -> 'a1 pol -> 'a1 pol **)
 
 let rec psquare cO cI cadd cmul ceqb = function
 | Pc c -> Pc (cmul c c)
@@ -3107,9 +852,9 @@ let mk_X cO cI j =
   mkPinj_pred j (mkX cO cI)
 
 (** val ppow_pos :
-    'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1
-    -> bool) -> ('a1 pol -> 'a1 pol) -> 'a1 pol -> 'a1 pol -> positive -> 'a1
-    pol **)
+    'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 ->
+    'a1 -> bool) -> ('a1 pol -> 'a1 pol) -> 'a1 pol -> 'a1 pol -> positive
+    -> 'a1 pol **)
 
 let rec ppow_pos cO cI cadd cmul ceqb subst_l res p = function
 | XI p3 ->
@@ -3123,16 +868,17 @@ let rec ppow_pos cO cI cadd cmul ceqb subst_l res p = function
 | XH -> subst_l (pmul cO cI cadd cmul ceqb res p)
 
 (** val ppow_N :
-    'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1
-    -> bool) -> ('a1 pol -> 'a1 pol) -> 'a1 pol -> n -> 'a1 pol **)
+    'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 ->
+    'a1 -> bool) -> ('a1 pol -> 'a1 pol) -> 'a1 pol -> n -> 'a1 pol **)
 
 let ppow_N cO cI cadd cmul ceqb subst_l p = function
 | N0 -> p1 cI
 | Npos p2 -> ppow_pos cO cI cadd cmul ceqb subst_l (p1 cI) p p2
 
 (** val norm_aux :
-    'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1
-    -> 'a1) -> ('a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 pExpr -> 'a1 pol **)
+    'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 ->
+    'a1 -> 'a1) -> ('a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 pExpr ->
+    'a1 pol **)
 
 let rec norm_aux cO cI cadd cmul csub copp ceqb = function
 | PEc c -> Pc c
@@ -3153,7 +899,8 @@ let rec norm_aux cO cI cadd cmul csub copp ceqb = function
         padd cO cadd ceqb (norm_aux cO cI cadd cmul csub copp ceqb pe1)
           (norm_aux cO cI cadd cmul csub copp ceqb pe2)))
 | PEsub (pe1, pe2) ->
-  psub cO cadd csub copp ceqb (norm_aux cO cI cadd cmul csub copp ceqb pe1)
+  psub cO cadd csub copp ceqb
+    (norm_aux cO cI cadd cmul csub copp ceqb pe1)
     (norm_aux cO cI cadd cmul csub copp ceqb pe2)
 | PEmul (pe1, pe2) ->
   pmul cO cI cadd cmul ceqb (norm_aux cO cI cadd cmul csub copp ceqb pe1)
@@ -3185,9 +932,9 @@ let rec map_bformula fct = function
 | N f0 -> N (map_bformula fct f0)
 | I (f1, f2) -> I ((map_bformula fct f1), (map_bformula fct f2))
 
-type 'term' clause = 'term' list
+type 'x clause = 'x list
 
-type 'term' cnf = 'term' clause list
+type 'x cnf = 'x clause list
 
 (** val tt : 'a1 cnf **)
 
@@ -3200,52 +947,52 @@ let ff =
   []::[]
 
 (** val add_term :
-    ('a1 -> bool) -> ('a1 -> 'a1 -> 'a1 option) -> 'a1 -> 'a1 clause -> 'a1
-    clause option **)
+    ('a1 -> bool) -> ('a1 -> 'a1 -> 'a1 option) -> 'a1 -> 'a1 clause ->
+    'a1 clause option **)
 
-let rec add_term unsat deduce t1 = function
+let rec add_term unsat deduce t0 = function
 | [] ->
-  (match deduce t1 t1 with
-   | Some u -> if unsat u then None else Some (t1::[])
-   | None -> Some (t1::[]))
+  (match deduce t0 t0 with
+   | Some u -> if unsat u then None else Some (t0::[])
+   | None -> Some (t0::[]))
 | t'::cl0 ->
-  (match deduce t1 t' with
+  (match deduce t0 t' with
    | Some u ->
      if unsat u
      then None
-     else (match add_term unsat deduce t1 cl0 with
+     else (match add_term unsat deduce t0 cl0 with
            | Some cl' -> Some (t'::cl')
            | None -> None)
    | None ->
-     (match add_term unsat deduce t1 cl0 with
+     (match add_term unsat deduce t0 cl0 with
       | Some cl' -> Some (t'::cl')
       | None -> None))
 
 (** val or_clause :
-    ('a1 -> bool) -> ('a1 -> 'a1 -> 'a1 option) -> 'a1 clause -> 'a1 clause
-    -> 'a1 clause option **)
+    ('a1 -> bool) -> ('a1 -> 'a1 -> 'a1 option) -> 'a1 clause -> 'a1
+    clause -> 'a1 clause option **)
 
 let rec or_clause unsat deduce cl1 cl2 =
   match cl1 with
   | [] -> Some cl2
-  | t1::cl ->
-    (match add_term unsat deduce t1 cl2 with
+  | t0::cl ->
+    (match add_term unsat deduce t0 cl2 with
      | Some cl' -> or_clause unsat deduce cl cl'
      | None -> None)
 
 (** val or_clause_cnf :
-    ('a1 -> bool) -> ('a1 -> 'a1 -> 'a1 option) -> 'a1 clause -> 'a1 cnf ->
-    'a1 cnf **)
+    ('a1 -> bool) -> ('a1 -> 'a1 -> 'a1 option) -> 'a1 clause -> 'a1 cnf
+    -> 'a1 cnf **)
 
-let or_clause_cnf unsat deduce t1 f =
+let or_clause_cnf unsat deduce t0 f =
   fold_right (fun e acc ->
-    match or_clause unsat deduce t1 e with
+    match or_clause unsat deduce t0 e with
     | Some cl -> cl::acc
     | None -> acc) [] f
 
 (** val or_cnf :
-    ('a1 -> bool) -> ('a1 -> 'a1 -> 'a1 option) -> 'a1 cnf -> 'a1 cnf -> 'a1
-    cnf **)
+    ('a1 -> bool) -> ('a1 -> 'a1 -> 'a1 option) -> 'a1 cnf -> 'a1 cnf ->
+    'a1 cnf **)
 
 let rec or_cnf unsat deduce f f' =
   match f with
@@ -3259,8 +1006,8 @@ let and_cnf f1 f2 =
   app f1 f2
 
 (** val xcnf :
-    ('a2 -> bool) -> ('a2 -> 'a2 -> 'a2 option) -> ('a1 -> 'a2 cnf) -> ('a1
-    -> 'a2 cnf) -> bool -> 'a1 bFormula -> 'a2 cnf **)
+    ('a2 -> bool) -> ('a2 -> 'a2 -> 'a2 option) -> ('a1 -> 'a2 cnf) ->
+    ('a1 -> 'a2 cnf) -> bool -> 'a1 bFormula -> 'a2 cnf **)
 
 let rec xcnf unsat deduce normalise0 negate0 pol0 = function
 | TT -> if pol0 then tt else ff
@@ -3300,9 +1047,9 @@ let rec cnf_checker checker f l =
      | c::l0 -> if checker e c then cnf_checker checker f0 l0 else false)
 
 (** val tauto_checker :
-    ('a2 -> bool) -> ('a2 -> 'a2 -> 'a2 option) -> ('a1 -> 'a2 cnf) -> ('a1
-    -> 'a2 cnf) -> ('a2 list -> 'a3 -> bool) -> 'a1 bFormula -> 'a3 list ->
-    bool **)
+    ('a2 -> bool) -> ('a2 -> 'a2 -> 'a2 option) -> ('a1 -> 'a2 cnf) ->
+    ('a1 -> 'a2 cnf) -> ('a2 list -> 'a3 -> bool) -> 'a1 bFormula -> 'a3
+    list -> bool **)
 
 let tauto_checker unsat deduce normalise0 negate0 checker f w =
   cnf_checker checker (xcnf unsat deduce normalise0 negate0 true f) w
@@ -3335,18 +1082,18 @@ let opMult o o' =
   | Equal -> Some Equal
   | NonEqual ->
     (match o' with
-     | Strict -> None
-     | NonStrict -> None
-     | x -> Some x)
+     | Equal -> Some Equal
+     | NonEqual -> Some NonEqual
+     | _ -> None)
   | Strict ->
     (match o' with
      | NonEqual -> None
      | _ -> Some o')
   | NonStrict ->
     (match o' with
+     | Equal -> Some Equal
      | NonEqual -> None
-     | Strict -> Some NonStrict
-     | x -> Some x)
+     | _ -> Some NonStrict)
 
 (** val opAdd : op1 -> op1 -> op1 option **)
 
@@ -3394,8 +1141,8 @@ let map_option2 f o o' =
   | None -> None
 
 (** val pexpr_times_nformula :
-    'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1
-    -> bool) -> 'a1 polC -> 'a1 nFormula -> 'a1 nFormula option **)
+    'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 ->
+    'a1 -> bool) -> 'a1 polC -> 'a1 nFormula -> 'a1 nFormula option **)
 
 let pexpr_times_nformula cO cI cplus ctimes ceqb e = function
 | ef,o ->
@@ -3404,8 +1151,8 @@ let pexpr_times_nformula cO cI cplus ctimes ceqb e = function
    | _ -> None)
 
 (** val nformula_times_nformula :
-    'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1
-    -> bool) -> 'a1 nFormula -> 'a1 nFormula -> 'a1 nFormula option **)
+    'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 ->
+    'a1 -> bool) -> 'a1 nFormula -> 'a1 nFormula -> 'a1 nFormula option **)
 
 let nformula_times_nformula cO cI cplus ctimes ceqb f1 f2 =
   let e1,o1 = f1 in
@@ -3414,8 +1161,8 @@ let nformula_times_nformula cO cI cplus ctimes ceqb f1 f2 =
     (opMult o1 o2)
 
 (** val nformula_plus_nformula :
-    'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 nFormula -> 'a1
-    nFormula -> 'a1 nFormula option **)
+    'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 nFormula ->
+    'a1 nFormula -> 'a1 nFormula option **)
 
 let nformula_plus_nformula cO cplus ceqb f1 f2 =
   let e1,o1 = f1 in
@@ -3423,9 +1170,9 @@ let nformula_plus_nformula cO cplus ceqb f1 f2 =
   map_option (fun x -> Some ((padd cO cplus ceqb e1 e2),x)) (opAdd o1 o2)
 
 (** val eval_Psatz :
-    'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1
-    -> bool) -> ('a1 -> 'a1 -> bool) -> 'a1 nFormula list -> 'a1 psatz -> 'a1
-    nFormula option **)
+    'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 ->
+    'a1 -> bool) -> ('a1 -> 'a1 -> bool) -> 'a1 nFormula list -> 'a1 psatz
+    -> 'a1 nFormula option **)
 
 let rec eval_Psatz cO cI cplus ctimes ceqb cleb l = function
 | PsatzIn n0 -> Some (nth n0 l ((Pc cO),Equal))
@@ -3460,9 +1207,9 @@ let check_inconsistent cO ceqb cleb = function
    | _ -> false)
 
 (** val check_normalised_formulas :
-    'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1
-    -> bool) -> ('a1 -> 'a1 -> bool) -> 'a1 nFormula list -> 'a1 psatz ->
-    bool **)
+    'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 ->
+    'a1 -> bool) -> ('a1 -> 'a1 -> bool) -> 'a1 nFormula list -> 'a1 psatz
+    -> bool **)
 
 let check_normalised_formulas cO cI cplus ctimes ceqb cleb l cm =
   match eval_Psatz cO cI cplus ctimes ceqb cleb l cm with
@@ -3479,51 +1226,41 @@ type op2 =
 
 type 't formula = { flhs : 't pExpr; fop : op2; frhs : 't pExpr }
 
-(** val flhs : 'a1 formula -> 'a1 pExpr **)
-
-let flhs x = x.flhs
-
-(** val fop : 'a1 formula -> op2 **)
-
-let fop x = x.fop
-
-(** val frhs : 'a1 formula -> 'a1 pExpr **)
-
-let frhs x = x.frhs
-
 (** val norm :
-    'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1
-    -> 'a1) -> ('a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 pExpr -> 'a1 pol **)
+    'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 ->
+    'a1 -> 'a1) -> ('a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 pExpr ->
+    'a1 pol **)
 
 let norm cO cI cplus ctimes cminus copp ceqb =
   norm_aux cO cI cplus ctimes cminus copp ceqb
 
 (** val psub0 :
-    'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1) -> ('a1
-    -> 'a1 -> bool) -> 'a1 pol -> 'a1 pol -> 'a1 pol **)
+    'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1) ->
+    ('a1 -> 'a1 -> bool) -> 'a1 pol -> 'a1 pol -> 'a1 pol **)
 
 let psub0 cO cplus cminus copp ceqb =
   psub cO cplus cminus copp ceqb
 
 (** val padd0 :
-    'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 pol -> 'a1 pol
-    -> 'a1 pol **)
+    'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 pol -> 'a1
+    pol -> 'a1 pol **)
 
 let padd0 cO cplus ceqb =
   padd cO cplus ceqb
 
 (** val xnormalise :
-    'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1
-    -> 'a1) -> ('a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 formula -> 'a1
-    nFormula list **)
+    'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 ->
+    'a1 -> 'a1) -> ('a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 formula ->
+    'a1 nFormula list **)
 
-let xnormalise cO cI cplus ctimes cminus copp ceqb t1 =
-  let { flhs = lhs; fop = o; frhs = rhs } = t1 in
+let xnormalise cO cI cplus ctimes cminus copp ceqb t0 =
+  let { flhs = lhs; fop = o; frhs = rhs } = t0 in
   let lhs0 = norm cO cI cplus ctimes cminus copp ceqb lhs in
   let rhs0 = norm cO cI cplus ctimes cminus copp ceqb rhs in
   (match o with
    | OpEq ->
-     ((psub0 cO cplus cminus copp ceqb lhs0 rhs0),Strict)::(((psub0 cO cplus
+     ((psub0 cO cplus cminus copp ceqb lhs0 rhs0),Strict)::(((psub0 cO
+                                                               cplus
                                                                cminus copp
                                                                ceqb rhs0
                                                                lhs0),Strict)::[])
@@ -3534,26 +1271,27 @@ let xnormalise cO cI cplus ctimes cminus copp ceqb t1 =
    | OpGt -> ((psub0 cO cplus cminus copp ceqb rhs0 lhs0),NonStrict)::[])
 
 (** val cnf_normalise :
-    'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1
-    -> 'a1) -> ('a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 formula -> 'a1
-    nFormula cnf **)
+    'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 ->
+    'a1 -> 'a1) -> ('a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 formula ->
+    'a1 nFormula cnf **)
 
-let cnf_normalise cO cI cplus ctimes cminus copp ceqb t1 =
-  map (fun x -> x::[]) (xnormalise cO cI cplus ctimes cminus copp ceqb t1)
+let cnf_normalise cO cI cplus ctimes cminus copp ceqb t0 =
+  map (fun x -> x::[]) (xnormalise cO cI cplus ctimes cminus copp ceqb t0)
 
 (** val xnegate :
-    'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1
-    -> 'a1) -> ('a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 formula -> 'a1
-    nFormula list **)
+    'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 ->
+    'a1 -> 'a1) -> ('a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 formula ->
+    'a1 nFormula list **)
 
-let xnegate cO cI cplus ctimes cminus copp ceqb t1 =
-  let { flhs = lhs; fop = o; frhs = rhs } = t1 in
+let xnegate cO cI cplus ctimes cminus copp ceqb t0 =
+  let { flhs = lhs; fop = o; frhs = rhs } = t0 in
   let lhs0 = norm cO cI cplus ctimes cminus copp ceqb lhs in
   let rhs0 = norm cO cI cplus ctimes cminus copp ceqb rhs in
   (match o with
    | OpEq -> ((psub0 cO cplus cminus copp ceqb lhs0 rhs0),Equal)::[]
    | OpNEq ->
-     ((psub0 cO cplus cminus copp ceqb lhs0 rhs0),Strict)::(((psub0 cO cplus
+     ((psub0 cO cplus cminus copp ceqb lhs0 rhs0),Strict)::(((psub0 cO
+                                                               cplus
                                                                cminus copp
                                                                ceqb rhs0
                                                                lhs0),Strict)::[])
@@ -3563,12 +1301,12 @@ let xnegate cO cI cplus ctimes cminus copp ceqb t1 =
    | OpGt -> ((psub0 cO cplus cminus copp ceqb lhs0 rhs0),Strict)::[])
 
 (** val cnf_negate :
-    'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1
-    -> 'a1) -> ('a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 formula -> 'a1
-    nFormula cnf **)
+    'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 ->
+    'a1 -> 'a1) -> ('a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 formula ->
+    'a1 nFormula cnf **)
 
-let cnf_negate cO cI cplus ctimes cminus copp ceqb t1 =
-  map (fun x -> x::[]) (xnegate cO cI cplus ctimes cminus copp ceqb t1)
+let cnf_negate cO cI cplus ctimes cminus copp ceqb t0 =
+  map (fun x -> x::[]) (xnegate cO cI cplus ctimes cminus copp ceqb t0)
 
 (** val xdenorm : positive -> 'a1 pol -> 'a1 pExpr **)
 
@@ -3602,14 +1340,14 @@ let map_Formula c_of_S f =
   { flhs = (map_PExpr c_of_S l); fop = o; frhs = (map_PExpr c_of_S r) }
 
 (** val simpl_cone :
-    'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 psatz ->
-    'a1 psatz **)
+    'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 psatz
+    -> 'a1 psatz **)
 
 let simpl_cone cO cI ctimes ceqb e = match e with
-| PsatzSquare t1 ->
-  (match t1 with
+| PsatzSquare t0 ->
+  (match t0 with
    | Pc c -> if ceqb cO c then PsatzZ else PsatzC (ctimes c c)
-   | _ -> PsatzSquare t1)
+   | _ -> PsatzSquare t0)
 | PsatzMulE (t1, t2) ->
   (match t1 with
    | PsatzMulE (x, x0) ->
@@ -3641,7 +1379,8 @@ let simpl_cone cO cI ctimes ceqb e = match e with
             | PsatzC p2 -> PsatzMulE ((PsatzC (ctimes c p2)), x)
             | _ -> if ceqb cI c then t2 else PsatzMulE (t1, t2)))
       | PsatzAdd (y, z0) ->
-        PsatzAdd ((PsatzMulE ((PsatzC c), y)), (PsatzMulE ((PsatzC c), z0)))
+        PsatzAdd ((PsatzMulE ((PsatzC c), y)), (PsatzMulE ((PsatzC c),
+          z0)))
       | PsatzC c0 -> PsatzC (ctimes c c0)
       | PsatzZ -> PsatzZ
       | _ -> if ceqb cI c then t2 else PsatzMulE (t1, t2))
@@ -3683,7 +1422,8 @@ let qle_bool x y =
 (** val qplus : q -> q -> q **)
 
 let qplus x y =
-  { qnum = (Z.add (Z.mul x.qnum (Zpos y.qden)) (Z.mul y.qnum (Zpos x.qden)));
+  { qnum =
+    (Z.add (Z.mul x.qnum (Zpos y.qden)) (Z.mul y.qnum (Zpos x.qden)));
     qden = (Coq_Pos.mul x.qden y.qden) }
 
 (** val qmult : q -> q -> q **)
@@ -3711,8 +1451,8 @@ let qinv x =
 
 (** val qpower_positive : q -> positive -> q **)
 
-let qpower_positive q0 p =
-  pow_pos qmult q0 p
+let qpower_positive =
+  pow_pos qmult
 
 (** val qpower : q -> z -> q **)
 
@@ -3721,12 +1461,12 @@ let qpower q0 = function
 | Zpos p -> qpower_positive q0 p
 | Zneg p -> qinv (qpower_positive q0 p)
 
-type 'a t0 =
+type 'a t =
 | Empty
 | Leaf of 'a
-| Node of 'a t0 * 'a * 'a t0
+| Node of 'a t * 'a * 'a t
 
-(** val find : 'a1 -> 'a1 t0 -> positive -> 'a1 **)
+(** val find : 'a1 -> 'a1 t -> positive -> 'a1 **)
 
 let rec find default vm p =
   match vm with
@@ -3738,6 +1478,29 @@ let rec find default vm p =
      | XO p2 -> find default l p2
      | XH -> e)
 
+(** val singleton : 'a1 -> positive -> 'a1 -> 'a1 t **)
+
+let rec singleton default x v =
+  match x with
+  | XI p -> Node (Empty, default, (singleton default p v))
+  | XO p -> Node ((singleton default p v), default, Empty)
+  | XH -> Leaf v
+
+(** val vm_add : 'a1 -> positive -> 'a1 -> 'a1 t -> 'a1 t **)
+
+let rec vm_add default x v = function
+| Empty -> singleton default x v
+| Leaf vl ->
+  (match x with
+   | XI p -> Node (Empty, vl, (singleton default p v))
+   | XO p -> Node ((singleton default p v), vl, Empty)
+   | XH -> Leaf v)
+| Node (l, o, r) ->
+  (match x with
+   | XI p -> Node (l, o, (vm_add default p v r))
+   | XO p -> Node ((vm_add default p v l), o, r)
+   | XH -> Node (l, v, r))
+
 type zWitness = z psatz
 
 (** val zWeakChecker : z nFormula list -> z psatz -> bool **)
@@ -3762,8 +1525,8 @@ let norm0 =
 
 (** val xnormalise0 : z formula -> z nFormula list **)
 
-let xnormalise0 t1 =
-  let { flhs = lhs; fop = o; frhs = rhs } = t1 in
+let xnormalise0 t0 =
+  let { flhs = lhs; fop = o; frhs = rhs } = t0 in
   let lhs0 = norm0 lhs in
   let rhs0 = norm0 rhs in
   (match o with
@@ -3780,13 +1543,13 @@ let xnormalise0 t1 =
 
 (** val normalise : z formula -> z nFormula cnf **)
 
-let normalise t1 =
-  map (fun x -> x::[]) (xnormalise0 t1)
+let normalise t0 =
+  map (fun x -> x::[]) (xnormalise0 t0)
 
 (** val xnegate0 : z formula -> z nFormula list **)
 
-let xnegate0 t1 =
-  let { flhs = lhs; fop = o; frhs = rhs } = t1 in
+let xnegate0 t0 =
+  let { flhs = lhs; fop = o; frhs = rhs } = t0 in
   let lhs0 = norm0 lhs in
   let rhs0 = norm0 rhs in
   (match o with
@@ -3803,8 +1566,8 @@ let xnegate0 t1 =
 
 (** val negate : z formula -> z nFormula cnf **)
 
-let negate t1 =
-  map (fun x -> x::[]) (xnegate0 t1)
+let negate t0 =
+  map (fun x -> x::[]) (xnegate0 t0)
 
 (** val zunsat : z nFormula -> bool **)
 
@@ -3839,8 +1602,8 @@ let zgcdM x y =
 
 let rec zgcd_pol = function
 | Pc c -> Z0,c
-| Pinj (p2, p3) -> zgcd_pol p3
-| PX (p2, p3, q0) ->
+| Pinj (_, p2) -> zgcd_pol p2
+| PX (p2, _, q0) ->
   let g1,c1 = zgcd_pol p2 in
   let g2,c2 = zgcd_pol q0 in (zgcdM (zgcdM g1 c1) g2),c2
 
@@ -3872,7 +1635,8 @@ let genCuttingPlane = function
      then None
      else Some ((makeCuttingPlane e),Equal)
    | NonEqual -> Some ((e,Z0),op)
-   | Strict -> Some ((makeCuttingPlane (psubC Z.sub e (Zpos XH))),NonStrict)
+   | Strict ->
+     Some ((makeCuttingPlane (psubC Z.sub e (Zpos XH))),NonStrict)
    | NonStrict -> Some ((makeCuttingPlane e),NonStrict))
 
 (** val nformula_of_cutting_plane : ((z polC * z) * op1) -> z nFormula **)
@@ -3966,8 +1730,8 @@ let qnormalise =
 (** val qnegate : q formula -> q nFormula cnf **)
 
 let qnegate =
-  cnf_negate { qnum = Z0; qden = XH } { qnum = (Zpos XH); qden = XH } qplus
-    qmult qminus qopp qeq_bool
+  cnf_negate { qnum = Z0; qden = XH } { qnum = (Zpos XH); qden = XH }
+    qplus qmult qminus qopp qeq_bool
 
 (** val qunsat : q nFormula -> bool **)
 
@@ -4025,8 +1789,8 @@ let rnormalise =
 (** val rnegate : q formula -> q nFormula cnf **)
 
 let rnegate =
-  cnf_negate { qnum = Z0; qden = XH } { qnum = (Zpos XH); qden = XH } qplus
-    qmult qminus qopp qeq_bool
+  cnf_negate { qnum = Z0; qden = XH } { qnum = (Zpos XH); qden = XH }
+    qplus qmult qminus qopp qeq_bool
 
 (** val runsat : q nFormula -> bool **)
 
@@ -4043,4 +1807,3 @@ let rdeduce =
 let rTautoChecker f w =
   tauto_checker runsat rdeduce rnormalise rnegate rWeakChecker
     (map_bformula (map_Formula q_of_Rcst) f) w
-
diff --git a/plugins/micromega/micromega.mli b/plugins/micromega/micromega.mli
index bcd61f39b..beb042f49 100644
--- a/plugins/micromega/micromega.mli
+++ b/plugins/micromega/micromega.mli
@@ -1,15 +1,9 @@
-type __ = Obj.t
-
 val negb : bool -> bool
 
 type nat =
 | O
 | S of nat
 
-val fst : ('a1 * 'a2) -> 'a1
-
-val snd : ('a1 * 'a2) -> 'a2
-
 val app : 'a1 list -> 'a1 list -> 'a1 list
 
 type comparison =
@@ -19,24 +13,7 @@ type comparison =
 
 val compOpp : comparison -> comparison
 
-type compareSpecT =
-| CompEqT
-| CompLtT
-| CompGtT
-
-val compareSpec2Type : comparison -> compareSpecT
-
-type 'a compSpecT = compareSpecT
-
-val compSpec2Type : 'a1 -> 'a1 -> comparison -> 'a1 compSpecT
-
-type 'a sig0 =
-  'a
-  (* singleton inductive, whose constructor was exist *)
-
-val plus : nat -> nat -> nat
-
-val nat_iter : nat -> ('a1 -> 'a1) -> 'a1 -> 'a1
+val add : nat -> nat -> nat
 
 type positive =
 | XI of positive
@@ -52,560 +29,59 @@ type z =
 | Zpos of positive
 | Zneg of positive
 
-module type TotalOrder' = 
- sig 
-  type t 
- end
-
-module MakeOrderTac : 
- functor (O:TotalOrder') ->
- sig 
-  
- end
-
-module MaxLogicalProperties : 
- functor (O:TotalOrder') ->
- functor (M:sig 
-  val max : O.t -> O.t -> O.t
- end) ->
- sig 
-  module T : 
-   sig 
-    
-   end
- end
-
-module Pos : 
- sig 
-  type t = positive
-  
-  val succ : positive -> positive
-  
-  val add : positive -> positive -> positive
-  
-  val add_carry : positive -> positive -> positive
-  
-  val pred_double : positive -> positive
-  
-  val pred : positive -> positive
-  
-  val pred_N : positive -> n
-  
+module Pos :
+ sig
   type mask =
   | IsNul
   | IsPos of positive
   | IsNeg
-  
-  val mask_rect : 'a1 -> (positive -> 'a1) -> 'a1 -> mask -> 'a1
-  
-  val mask_rec : 'a1 -> (positive -> 'a1) -> 'a1 -> mask -> 'a1
-  
-  val succ_double_mask : mask -> mask
-  
-  val double_mask : mask -> mask
-  
-  val double_pred_mask : positive -> mask
-  
-  val pred_mask : mask -> mask
-  
-  val sub_mask : positive -> positive -> mask
-  
-  val sub_mask_carry : positive -> positive -> mask
-  
-  val sub : positive -> positive -> positive
-  
-  val mul : positive -> positive -> positive
-  
-  val iter : positive -> ('a1 -> 'a1) -> 'a1 -> 'a1
-  
-  val pow : positive -> positive -> positive
-  
-  val div2 : positive -> positive
-  
-  val div2_up : positive -> positive
-  
-  val size_nat : positive -> nat
-  
-  val size : positive -> positive
-  
-  val compare_cont : positive -> positive -> comparison -> comparison
-  
-  val compare : positive -> positive -> comparison
-  
-  val min : positive -> positive -> positive
-  
-  val max : positive -> positive -> positive
-  
-  val eqb : positive -> positive -> bool
-  
-  val leb : positive -> positive -> bool
-  
-  val ltb : positive -> positive -> bool
-  
-  val sqrtrem_step :
-    (positive -> positive) -> (positive -> positive) -> (positive * mask) ->
-    positive * mask
-  
-  val sqrtrem : positive -> positive * mask
-  
-  val sqrt : positive -> positive
-  
-  val gcdn : nat -> positive -> positive -> positive
-  
-  val gcd : positive -> positive -> positive
-  
-  val ggcdn : nat -> positive -> positive -> positive * (positive * positive)
-  
-  val ggcd : positive -> positive -> positive * (positive * positive)
-  
-  val coq_Nsucc_double : n -> n
-  
-  val coq_Ndouble : n -> n
-  
-  val coq_lor : positive -> positive -> positive
-  
-  val coq_land : positive -> positive -> n
-  
-  val ldiff : positive -> positive -> n
-  
-  val coq_lxor : positive -> positive -> n
-  
-  val shiftl_nat : positive -> nat -> positive
-  
-  val shiftr_nat : positive -> nat -> positive
-  
-  val shiftl : positive -> n -> positive
-  
-  val shiftr : positive -> n -> positive
-  
-  val testbit_nat : positive -> nat -> bool
-  
-  val testbit : positive -> n -> bool
-  
-  val iter_op : ('a1 -> 'a1 -> 'a1) -> positive -> 'a1 -> 'a1
-  
-  val to_nat : positive -> nat
-  
-  val of_nat : nat -> positive
-  
-  val of_succ_nat : nat -> positive
  end
 
-module Coq_Pos : 
- sig 
-  module Coq__1 : sig 
-   type t = positive
-  end
-  type t = Coq__1.t
-  
+module Coq_Pos :
+ sig
   val succ : positive -> positive
-  
+
   val add : positive -> positive -> positive
-  
+
   val add_carry : positive -> positive -> positive
-  
+
   val pred_double : positive -> positive
-  
-  val pred : positive -> positive
-  
-  val pred_N : positive -> n
-  
+
   type mask = Pos.mask =
   | IsNul
   | IsPos of positive
   | IsNeg
-  
-  val mask_rect : 'a1 -> (positive -> 'a1) -> 'a1 -> mask -> 'a1
-  
-  val mask_rec : 'a1 -> (positive -> 'a1) -> 'a1 -> mask -> 'a1
-  
+
   val succ_double_mask : mask -> mask
-  
+
   val double_mask : mask -> mask
-  
+
   val double_pred_mask : positive -> mask
-  
-  val pred_mask : mask -> mask
-  
+
   val sub_mask : positive -> positive -> mask
-  
+
   val sub_mask_carry : positive -> positive -> mask
-  
+
   val sub : positive -> positive -> positive
-  
+
   val mul : positive -> positive -> positive
-  
-  val iter : positive -> ('a1 -> 'a1) -> 'a1 -> 'a1
-  
-  val pow : positive -> positive -> positive
-  
-  val div2 : positive -> positive
-  
-  val div2_up : positive -> positive
-  
+
   val size_nat : positive -> nat
-  
-  val size : positive -> positive
-  
-  val compare_cont : positive -> positive -> comparison -> comparison
-  
+
+  val compare_cont : comparison -> positive -> positive -> comparison
+
   val compare : positive -> positive -> comparison
-  
-  val min : positive -> positive -> positive
-  
-  val max : positive -> positive -> positive
-  
-  val eqb : positive -> positive -> bool
-  
-  val leb : positive -> positive -> bool
-  
-  val ltb : positive -> positive -> bool
-  
-  val sqrtrem_step :
-    (positive -> positive) -> (positive -> positive) -> (positive * mask) ->
-    positive * mask
-  
-  val sqrtrem : positive -> positive * mask
-  
-  val sqrt : positive -> positive
-  
+
   val gcdn : nat -> positive -> positive -> positive
-  
+
   val gcd : positive -> positive -> positive
-  
-  val ggcdn : nat -> positive -> positive -> positive * (positive * positive)
-  
-  val ggcd : positive -> positive -> positive * (positive * positive)
-  
-  val coq_Nsucc_double : n -> n
-  
-  val coq_Ndouble : n -> n
-  
-  val coq_lor : positive -> positive -> positive
-  
-  val coq_land : positive -> positive -> n
-  
-  val ldiff : positive -> positive -> n
-  
-  val coq_lxor : positive -> positive -> n
-  
-  val shiftl_nat : positive -> nat -> positive
-  
-  val shiftr_nat : positive -> nat -> positive
-  
-  val shiftl : positive -> n -> positive
-  
-  val shiftr : positive -> n -> positive
-  
-  val testbit_nat : positive -> nat -> bool
-  
-  val testbit : positive -> n -> bool
-  
-  val iter_op : ('a1 -> 'a1 -> 'a1) -> positive -> 'a1 -> 'a1
-  
-  val to_nat : positive -> nat
-  
-  val of_nat : nat -> positive
-  
+
   val of_succ_nat : nat -> positive
-  
-  val eq_dec : positive -> positive -> bool
-  
-  val peano_rect : 'a1 -> (positive -> 'a1 -> 'a1) -> positive -> 'a1
-  
-  val peano_rec : 'a1 -> (positive -> 'a1 -> 'a1) -> positive -> 'a1
-  
-  type coq_PeanoView =
-  | PeanoOne
-  | PeanoSucc of positive * coq_PeanoView
-  
-  val coq_PeanoView_rect :
-    'a1 -> (positive -> coq_PeanoView -> 'a1 -> 'a1) -> positive ->
-    coq_PeanoView -> 'a1
-  
-  val coq_PeanoView_rec :
-    'a1 -> (positive -> coq_PeanoView -> 'a1 -> 'a1) -> positive ->
-    coq_PeanoView -> 'a1
-  
-  val peanoView_xO : positive -> coq_PeanoView -> coq_PeanoView
-  
-  val peanoView_xI : positive -> coq_PeanoView -> coq_PeanoView
-  
-  val peanoView : positive -> coq_PeanoView
-  
-  val coq_PeanoView_iter :
-    'a1 -> (positive -> 'a1 -> 'a1) -> positive -> coq_PeanoView -> 'a1
-  
-  val switch_Eq : comparison -> comparison -> comparison
-  
-  val mask2cmp : mask -> comparison
-  
-  module T : 
-   sig 
-    
-   end
-  
-  module ORev : 
-   sig 
-    type t = Coq__1.t
-   end
-  
-  module MRev : 
-   sig 
-    val max : t -> t -> t
-   end
-  
-  module MPRev : 
-   sig 
-    module T : 
-     sig 
-      
-     end
-   end
-  
-  module P : 
-   sig 
-    val max_case_strong :
-      t -> t -> (t -> t -> __ -> 'a1 -> 'a1) -> (__ -> 'a1) -> (__ -> 'a1) ->
-      'a1
-    
-    val max_case :
-      t -> t -> (t -> t -> __ -> 'a1 -> 'a1) -> 'a1 -> 'a1 -> 'a1
-    
-    val max_dec : t -> t -> bool
-    
-    val min_case_strong :
-      t -> t -> (t -> t -> __ -> 'a1 -> 'a1) -> (__ -> 'a1) -> (__ -> 'a1) ->
-      'a1
-    
-    val min_case :
-      t -> t -> (t -> t -> __ -> 'a1 -> 'a1) -> 'a1 -> 'a1 -> 'a1
-    
-    val min_dec : t -> t -> bool
-   end
-  
-  val max_case_strong : t -> t -> (__ -> 'a1) -> (__ -> 'a1) -> 'a1
-  
-  val max_case : t -> t -> 'a1 -> 'a1 -> 'a1
-  
-  val max_dec : t -> t -> bool
-  
-  val min_case_strong : t -> t -> (__ -> 'a1) -> (__ -> 'a1) -> 'a1
-  
-  val min_case : t -> t -> 'a1 -> 'a1 -> 'a1
-  
-  val min_dec : t -> t -> bool
  end
 
-module N : 
- sig 
-  type t = n
-  
-  val zero : n
-  
-  val one : n
-  
-  val two : n
-  
-  val succ_double : n -> n
-  
-  val double : n -> n
-  
-  val succ : n -> n
-  
-  val pred : n -> n
-  
-  val succ_pos : n -> positive
-  
-  val add : n -> n -> n
-  
-  val sub : n -> n -> n
-  
-  val mul : n -> n -> n
-  
-  val compare : n -> n -> comparison
-  
-  val eqb : n -> n -> bool
-  
-  val leb : n -> n -> bool
-  
-  val ltb : n -> n -> bool
-  
-  val min : n -> n -> n
-  
-  val max : n -> n -> n
-  
-  val div2 : n -> n
-  
-  val even : n -> bool
-  
-  val odd : n -> bool
-  
-  val pow : n -> n -> n
-  
-  val log2 : n -> n
-  
-  val size : n -> n
-  
-  val size_nat : n -> nat
-  
-  val pos_div_eucl : positive -> n -> n * n
-  
-  val div_eucl : n -> n -> n * n
-  
-  val div : n -> n -> n
-  
-  val modulo : n -> n -> n
-  
-  val gcd : n -> n -> n
-  
-  val ggcd : n -> n -> n * (n * n)
-  
-  val sqrtrem : n -> n * n
-  
-  val sqrt : n -> n
-  
-  val coq_lor : n -> n -> n
-  
-  val coq_land : n -> n -> n
-  
-  val ldiff : n -> n -> n
-  
-  val coq_lxor : n -> n -> n
-  
-  val shiftl_nat : n -> nat -> n
-  
-  val shiftr_nat : n -> nat -> n
-  
-  val shiftl : n -> n -> n
-  
-  val shiftr : n -> n -> n
-  
-  val testbit_nat : n -> nat -> bool
-  
-  val testbit : n -> n -> bool
-  
-  val to_nat : n -> nat
-  
+module N :
+ sig
   val of_nat : nat -> n
-  
-  val iter : n -> ('a1 -> 'a1) -> 'a1 -> 'a1
-  
-  val eq_dec : n -> n -> bool
-  
-  val discr : n -> positive option
-  
-  val binary_rect : 'a1 -> (n -> 'a1 -> 'a1) -> (n -> 'a1 -> 'a1) -> n -> 'a1
-  
-  val binary_rec : 'a1 -> (n -> 'a1 -> 'a1) -> (n -> 'a1 -> 'a1) -> n -> 'a1
-  
-  val peano_rect : 'a1 -> (n -> 'a1 -> 'a1) -> n -> 'a1
-  
-  val peano_rec : 'a1 -> (n -> 'a1 -> 'a1) -> n -> 'a1
-  
-  module BootStrap : 
-   sig 
-    
-   end
-  
-  val recursion : 'a1 -> (n -> 'a1 -> 'a1) -> n -> 'a1
-  
-  module OrderElts : 
-   sig 
-    type t = n
-   end
-  
-  module OrderTac : 
-   sig 
-    
-   end
-  
-  module NZPowP : 
-   sig 
-    
-   end
-  
-  module NZSqrtP : 
-   sig 
-    
-   end
-  
-  val sqrt_up : n -> n
-  
-  val log2_up : n -> n
-  
-  module NZDivP : 
-   sig 
-    
-   end
-  
-  val lcm : n -> n -> n
-  
-  val b2n : bool -> n
-  
-  val setbit : n -> n -> n
-  
-  val clearbit : n -> n -> n
-  
-  val ones : n -> n
-  
-  val lnot : n -> n -> n
-  
-  module T : 
-   sig 
-    
-   end
-  
-  module ORev : 
-   sig 
-    type t = n
-   end
-  
-  module MRev : 
-   sig 
-    val max : n -> n -> n
-   end
-  
-  module MPRev : 
-   sig 
-    module T : 
-     sig 
-      
-     end
-   end
-  
-  module P : 
-   sig 
-    val max_case_strong :
-      n -> n -> (n -> n -> __ -> 'a1 -> 'a1) -> (__ -> 'a1) -> (__ -> 'a1) ->
-      'a1
-    
-    val max_case :
-      n -> n -> (n -> n -> __ -> 'a1 -> 'a1) -> 'a1 -> 'a1 -> 'a1
-    
-    val max_dec : n -> n -> bool
-    
-    val min_case_strong :
-      n -> n -> (n -> n -> __ -> 'a1 -> 'a1) -> (__ -> 'a1) -> (__ -> 'a1) ->
-      'a1
-    
-    val min_case :
-      n -> n -> (n -> n -> __ -> 'a1 -> 'a1) -> 'a1 -> 'a1 -> 'a1
-    
-    val min_dec : n -> n -> bool
-   end
-  
-  val max_case_strong : n -> n -> (__ -> 'a1) -> (__ -> 'a1) -> 'a1
-  
-  val max_case : n -> n -> 'a1 -> 'a1 -> 'a1
-  
-  val max_dec : n -> n -> bool
-  
-  val min_case_strong : n -> n -> (__ -> 'a1) -> (__ -> 'a1) -> 'a1
-  
-  val min_case : n -> n -> 'a1 -> 'a1 -> 'a1
-  
-  val min_dec : n -> n -> bool
  end
 
 val pow_pos : ('a1 -> 'a1 -> 'a1) -> 'a1 -> positive -> 'a1
@@ -616,225 +92,45 @@ val map : ('a1 -> 'a2) -> 'a1 list -> 'a2 list
 
 val fold_right : ('a2 -> 'a1 -> 'a1) -> 'a1 -> 'a2 list -> 'a1
 
-module Z : 
- sig 
-  type t = z
-  
-  val zero : z
-  
-  val one : z
-  
-  val two : z
-  
+module Z :
+ sig
   val double : z -> z
-  
+
   val succ_double : z -> z
-  
+
   val pred_double : z -> z
-  
+
   val pos_sub : positive -> positive -> z
-  
+
   val add : z -> z -> z
-  
+
   val opp : z -> z
-  
-  val succ : z -> z
-  
-  val pred : z -> z
-  
+
   val sub : z -> z -> z
-  
+
   val mul : z -> z -> z
-  
-  val pow_pos : z -> positive -> z
-  
-  val pow : z -> z -> z
-  
+
   val compare : z -> z -> comparison
-  
-  val sgn : z -> z
-  
+
   val leb : z -> z -> bool
-  
-  val geb : z -> z -> bool
-  
+
   val ltb : z -> z -> bool
-  
+
   val gtb : z -> z -> bool
-  
-  val eqb : z -> z -> bool
-  
+
   val max : z -> z -> z
-  
-  val min : z -> z -> z
-  
+
   val abs : z -> z
-  
-  val abs_nat : z -> nat
-  
-  val abs_N : z -> n
-  
-  val to_nat : z -> nat
-  
+
   val to_N : z -> n
-  
-  val of_nat : nat -> z
-  
-  val of_N : n -> z
-  
-  val iter : z -> ('a1 -> 'a1) -> 'a1 -> 'a1
-  
+
   val pos_div_eucl : positive -> z -> z * z
-  
+
   val div_eucl : z -> z -> z * z
-  
+
   val div : z -> z -> z
-  
-  val modulo : z -> z -> z
-  
-  val quotrem : z -> z -> z * z
-  
-  val quot : z -> z -> z
-  
-  val rem : z -> z -> z
-  
-  val even : z -> bool
-  
-  val odd : z -> bool
-  
-  val div2 : z -> z
-  
-  val quot2 : z -> z
-  
-  val log2 : z -> z
-  
-  val sqrtrem : z -> z * z
-  
-  val sqrt : z -> z
-  
+
   val gcd : z -> z -> z
-  
-  val ggcd : z -> z -> z * (z * z)
-  
-  val testbit : z -> z -> bool
-  
-  val shiftl : z -> z -> z
-  
-  val shiftr : z -> z -> z
-  
-  val coq_lor : z -> z -> z
-  
-  val coq_land : z -> z -> z
-  
-  val ldiff : z -> z -> z
-  
-  val coq_lxor : z -> z -> z
-  
-  val eq_dec : z -> z -> bool
-  
-  module BootStrap : 
-   sig 
-    
-   end
-  
-  module OrderElts : 
-   sig 
-    type t = z
-   end
-  
-  module OrderTac : 
-   sig 
-    
-   end
-  
-  val sqrt_up : z -> z
-  
-  val log2_up : z -> z
-  
-  module NZDivP : 
-   sig 
-    
-   end
-  
-  module Quot2Div : 
-   sig 
-    val div : z -> z -> z
-    
-    val modulo : z -> z -> z
-   end
-  
-  module NZQuot : 
-   sig 
-    
-   end
-  
-  val lcm : z -> z -> z
-  
-  val b2z : bool -> z
-  
-  val setbit : z -> z -> z
-  
-  val clearbit : z -> z -> z
-  
-  val lnot : z -> z
-  
-  val ones : z -> z
-  
-  module T : 
-   sig 
-    
-   end
-  
-  module ORev : 
-   sig 
-    type t = z
-   end
-  
-  module MRev : 
-   sig 
-    val max : z -> z -> z
-   end
-  
-  module MPRev : 
-   sig 
-    module T : 
-     sig 
-      
-     end
-   end
-  
-  module P : 
-   sig 
-    val max_case_strong :
-      z -> z -> (z -> z -> __ -> 'a1 -> 'a1) -> (__ -> 'a1) -> (__ -> 'a1) ->
-      'a1
-    
-    val max_case :
-      z -> z -> (z -> z -> __ -> 'a1 -> 'a1) -> 'a1 -> 'a1 -> 'a1
-    
-    val max_dec : z -> z -> bool
-    
-    val min_case_strong :
-      z -> z -> (z -> z -> __ -> 'a1 -> 'a1) -> (__ -> 'a1) -> (__ -> 'a1) ->
-      'a1
-    
-    val min_case :
-      z -> z -> (z -> z -> __ -> 'a1 -> 'a1) -> 'a1 -> 'a1 -> 'a1
-    
-    val min_dec : z -> z -> bool
-   end
-  
-  val max_case_strong : z -> z -> (__ -> 'a1) -> (__ -> 'a1) -> 'a1
-  
-  val max_case : z -> z -> 'a1 -> 'a1 -> 'a1
-  
-  val max_dec : z -> z -> bool
-  
-  val min_case_strong : z -> z -> (__ -> 'a1) -> (__ -> 'a1) -> 'a1
-  
-  val min_case : z -> z -> 'a1 -> 'a1 -> 'a1
-  
-  val min_dec : z -> z -> bool
  end
 
 val zeq_bool : z -> z -> bool
@@ -872,44 +168,44 @@ val paddI :
   positive -> 'a1 pol -> 'a1 pol
 
 val psubI :
-  ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1) -> ('a1 pol -> 'a1 pol -> 'a1 pol) ->
-  'a1 pol -> positive -> 'a1 pol -> 'a1 pol
+  ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1) -> ('a1 pol -> 'a1 pol -> 'a1 pol)
+  -> 'a1 pol -> positive -> 'a1 pol -> 'a1 pol
 
 val paddX :
-  'a1 -> ('a1 -> 'a1 -> bool) -> ('a1 pol -> 'a1 pol -> 'a1 pol) -> 'a1 pol
-  -> positive -> 'a1 pol -> 'a1 pol
+  'a1 -> ('a1 -> 'a1 -> bool) -> ('a1 pol -> 'a1 pol -> 'a1 pol) -> 'a1
+  pol -> positive -> 'a1 pol -> 'a1 pol
 
 val psubX :
-  'a1 -> ('a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> ('a1 pol -> 'a1 pol -> 'a1
-  pol) -> 'a1 pol -> positive -> 'a1 pol -> 'a1 pol
+  'a1 -> ('a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> ('a1 pol -> 'a1 pol ->
+  'a1 pol) -> 'a1 pol -> positive -> 'a1 pol -> 'a1 pol
 
 val padd :
-  'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 pol -> 'a1 pol ->
-  'a1 pol
+  'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 pol -> 'a1 pol
+  -> 'a1 pol
 
 val psub :
-  'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1) -> ('a1
-  -> 'a1 -> bool) -> 'a1 pol -> 'a1 pol -> 'a1 pol
+  'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1) ->
+  ('a1 -> 'a1 -> bool) -> 'a1 pol -> 'a1 pol -> 'a1 pol
 
 val pmulC_aux :
-  'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 pol -> 'a1 -> 'a1
-  pol
+  'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 pol -> 'a1 ->
+  'a1 pol
 
 val pmulC :
-  'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 pol -> 'a1
-  -> 'a1 pol
+  'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 pol ->
+  'a1 -> 'a1 pol
 
 val pmulI :
   'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> ('a1 pol ->
   'a1 pol -> 'a1 pol) -> 'a1 pol -> positive -> 'a1 pol -> 'a1 pol
 
 val pmul :
-  'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 ->
-  bool) -> 'a1 pol -> 'a1 pol -> 'a1 pol
+  'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1
+  -> bool) -> 'a1 pol -> 'a1 pol -> 'a1 pol
 
 val psquare :
-  'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 ->
-  bool) -> 'a1 pol -> 'a1 pol
+  'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1
+  -> bool) -> 'a1 pol -> 'a1 pol
 
 type 'c pExpr =
 | PEc of 'c
@@ -923,16 +219,17 @@ type 'c pExpr =
 val mk_X : 'a1 -> 'a1 -> positive -> 'a1 pol
 
 val ppow_pos :
-  'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 ->
-  bool) -> ('a1 pol -> 'a1 pol) -> 'a1 pol -> 'a1 pol -> positive -> 'a1 pol
+  'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1
+  -> bool) -> ('a1 pol -> 'a1 pol) -> 'a1 pol -> 'a1 pol -> positive ->
+  'a1 pol
 
 val ppow_N :
-  'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 ->
-  bool) -> ('a1 pol -> 'a1 pol) -> 'a1 pol -> n -> 'a1 pol
+  'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1
+  -> bool) -> ('a1 pol -> 'a1 pol) -> 'a1 pol -> n -> 'a1 pol
 
 val norm_aux :
-  'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 ->
-  'a1) -> ('a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 pExpr -> 'a1 pol
+  'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1
+  -> 'a1) -> ('a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 pExpr -> 'a1 pol
 
 type 'a bFormula =
 | TT
@@ -946,9 +243,9 @@ type 'a bFormula =
 
 val map_bformula : ('a1 -> 'a2) -> 'a1 bFormula -> 'a2 bFormula
 
-type 'term' clause = 'term' list
+type 'x clause = 'x list
 
-type 'term' cnf = 'term' clause list
+type 'x cnf = 'x clause list
 
 val tt : 'a1 cnf
 
@@ -959,12 +256,12 @@ val add_term :
   clause option
 
 val or_clause :
-  ('a1 -> bool) -> ('a1 -> 'a1 -> 'a1 option) -> 'a1 clause -> 'a1 clause ->
-  'a1 clause option
+  ('a1 -> bool) -> ('a1 -> 'a1 -> 'a1 option) -> 'a1 clause -> 'a1 clause
+  -> 'a1 clause option
 
 val or_clause_cnf :
-  ('a1 -> bool) -> ('a1 -> 'a1 -> 'a1 option) -> 'a1 clause -> 'a1 cnf -> 'a1
-  cnf
+  ('a1 -> bool) -> ('a1 -> 'a1 -> 'a1 option) -> 'a1 clause -> 'a1 cnf ->
+  'a1 cnf
 
 val or_cnf :
   ('a1 -> bool) -> ('a1 -> 'a1 -> 'a1 option) -> 'a1 cnf -> 'a1 cnf -> 'a1
@@ -973,18 +270,20 @@ val or_cnf :
 val and_cnf : 'a1 cnf -> 'a1 cnf -> 'a1 cnf
 
 val xcnf :
-  ('a2 -> bool) -> ('a2 -> 'a2 -> 'a2 option) -> ('a1 -> 'a2 cnf) -> ('a1 ->
-  'a2 cnf) -> bool -> 'a1 bFormula -> 'a2 cnf
+  ('a2 -> bool) -> ('a2 -> 'a2 -> 'a2 option) -> ('a1 -> 'a2 cnf) -> ('a1
+  -> 'a2 cnf) -> bool -> 'a1 bFormula -> 'a2 cnf
 
 val cnf_checker : ('a1 list -> 'a2 -> bool) -> 'a1 cnf -> 'a2 list -> bool
 
 val tauto_checker :
-  ('a2 -> bool) -> ('a2 -> 'a2 -> 'a2 option) -> ('a1 -> 'a2 cnf) -> ('a1 ->
-  'a2 cnf) -> ('a2 list -> 'a3 -> bool) -> 'a1 bFormula -> 'a3 list -> bool
+  ('a2 -> bool) -> ('a2 -> 'a2 -> 'a2 option) -> ('a1 -> 'a2 cnf) -> ('a1
+  -> 'a2 cnf) -> ('a2 list -> 'a3 -> bool) -> 'a1 bFormula -> 'a3 list ->
+  bool
 
 val cneqb : ('a1 -> 'a1 -> bool) -> 'a1 -> 'a1 -> bool
 
-val cltb : ('a1 -> 'a1 -> bool) -> ('a1 -> 'a1 -> bool) -> 'a1 -> 'a1 -> bool
+val cltb :
+  ('a1 -> 'a1 -> bool) -> ('a1 -> 'a1 -> bool) -> 'a1 -> 'a1 -> bool
 
 type 'c polC = 'c pol
 
@@ -1015,28 +314,30 @@ val map_option2 :
   ('a1 -> 'a2 -> 'a3 option) -> 'a1 option -> 'a2 option -> 'a3 option
 
 val pexpr_times_nformula :
-  'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 ->
-  bool) -> 'a1 polC -> 'a1 nFormula -> 'a1 nFormula option
+  'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1
+  -> bool) -> 'a1 polC -> 'a1 nFormula -> 'a1 nFormula option
 
 val nformula_times_nformula :
-  'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 ->
-  bool) -> 'a1 nFormula -> 'a1 nFormula -> 'a1 nFormula option
+  'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1
+  -> bool) -> 'a1 nFormula -> 'a1 nFormula -> 'a1 nFormula option
 
 val nformula_plus_nformula :
-  'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 nFormula -> 'a1
-  nFormula -> 'a1 nFormula option
+  'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 nFormula ->
+  'a1 nFormula -> 'a1 nFormula option
 
 val eval_Psatz :
-  'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 ->
-  bool) -> ('a1 -> 'a1 -> bool) -> 'a1 nFormula list -> 'a1 psatz -> 'a1
-  nFormula option
+  'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1
+  -> bool) -> ('a1 -> 'a1 -> bool) -> 'a1 nFormula list -> 'a1 psatz ->
+  'a1 nFormula option
 
 val check_inconsistent :
-  'a1 -> ('a1 -> 'a1 -> bool) -> ('a1 -> 'a1 -> bool) -> 'a1 nFormula -> bool
+  'a1 -> ('a1 -> 'a1 -> bool) -> ('a1 -> 'a1 -> bool) -> 'a1 nFormula ->
+  bool
 
 val check_normalised_formulas :
-  'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 ->
-  bool) -> ('a1 -> 'a1 -> bool) -> 'a1 nFormula list -> 'a1 psatz -> bool
+  'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1
+  -> bool) -> ('a1 -> 'a1 -> bool) -> 'a1 nFormula list -> 'a1 psatz ->
+  bool
 
 type op2 =
 | OpEq
@@ -1048,43 +349,37 @@ type op2 =
 
 type 't formula = { flhs : 't pExpr; fop : op2; frhs : 't pExpr }
 
-val flhs : 'a1 formula -> 'a1 pExpr
-
-val fop : 'a1 formula -> op2
-
-val frhs : 'a1 formula -> 'a1 pExpr
-
 val norm :
-  'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 ->
-  'a1) -> ('a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 pExpr -> 'a1 pol
+  'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1
+  -> 'a1) -> ('a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 pExpr -> 'a1 pol
 
 val psub0 :
-  'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1) -> ('a1
-  -> 'a1 -> bool) -> 'a1 pol -> 'a1 pol -> 'a1 pol
+  'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1) ->
+  ('a1 -> 'a1 -> bool) -> 'a1 pol -> 'a1 pol -> 'a1 pol
 
 val padd0 :
-  'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 pol -> 'a1 pol ->
-  'a1 pol
+  'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 pol -> 'a1 pol
+  -> 'a1 pol
 
 val xnormalise :
-  'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 ->
-  'a1) -> ('a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 formula -> 'a1 nFormula
-  list
+  'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1
+  -> 'a1) -> ('a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 formula -> 'a1
+  nFormula list
 
 val cnf_normalise :
-  'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 ->
-  'a1) -> ('a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 formula -> 'a1 nFormula
-  cnf
+  'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1
+  -> 'a1) -> ('a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 formula -> 'a1
+  nFormula cnf
 
 val xnegate :
-  'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 ->
-  'a1) -> ('a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 formula -> 'a1 nFormula
-  list
+  'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1
+  -> 'a1) -> ('a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 formula -> 'a1
+  nFormula list
 
 val cnf_negate :
-  'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 ->
-  'a1) -> ('a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 formula -> 'a1 nFormula
-  cnf
+  'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1
+  -> 'a1) -> ('a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 formula -> 'a1
+  nFormula cnf
 
 val xdenorm : positive -> 'a1 pol -> 'a1 pExpr
 
@@ -1095,8 +390,8 @@ val map_PExpr : ('a2 -> 'a1) -> 'a2 pExpr -> 'a1 pExpr
 val map_Formula : ('a2 -> 'a1) -> 'a2 formula -> 'a1 formula
 
 val simpl_cone :
-  'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 psatz ->
-  'a1 psatz
+  'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 psatz
+  -> 'a1 psatz
 
 type q = { qnum : z; qden : positive }
 
@@ -1122,12 +417,16 @@ val qpower_positive : q -> positive -> q
 
 val qpower : q -> z -> q
 
-type 'a t0 =
+type 'a t =
 | Empty
 | Leaf of 'a
-| Node of 'a t0 * 'a * 'a t0
+| Node of 'a t * 'a * 'a t
+
+val find : 'a1 -> 'a1 t -> positive -> 'a1
 
-val find : 'a1 -> 'a1 t0 -> positive -> 'a1
+val singleton : 'a1 -> positive -> 'a1 -> 'a1 t
+
+val vm_add : 'a1 -> positive -> 'a1 -> 'a1 t -> 'a1 t
 
 type zWitness = z psatz
 
@@ -1221,4 +520,3 @@ val runsat : q nFormula -> bool
 val rdeduce : q nFormula -> q nFormula -> q nFormula option
 
 val rTautoChecker : rcst formula bFormula -> rWitness list -> bool
-
diff --git a/plugins/micromega/micromega_plugin.mllib b/plugins/micromega/micromega_plugin.mlpack
index f53a9e379..ed253da3f 100644
--- a/plugins/micromega/micromega_plugin.mllib
+++ b/plugins/micromega/micromega_plugin.mlpack
@@ -7,4 +7,3 @@ Certificate
 Persistent_cache
 Coq_micromega
 G_micromega
-Micromega_plugin_mod
diff --git a/plugins/micromega/mutils.ml b/plugins/micromega/mutils.ml
index c13e8fc28..b4c6d032b 100644
--- a/plugins/micromega/mutils.ml
+++ b/plugins/micromega/mutils.ml
@@ -294,18 +294,6 @@ struct
   else  XO (index (n lsr 1))
 
 
- let idx n =
-  (*a.k.a path_of_int *)
-  (* returns the list of digits of n in reverse order with initial 1 removed *)
-  let rec digits_of_int n =
-   if Int.equal n 1 then []
-   else (Int.equal (n mod 2) 1)::(digits_of_int (n lsr 1))
-  in
-   List.fold_right
-    (fun b c -> (if b then XI c else XO c))
-    (List.rev (digits_of_int n))
-    (XH)
-
  let z x =
   match compare x 0 with
    | 0 -> Z0
diff --git a/plugins/micromega/persistent_cache.ml b/plugins/micromega/persistent_cache.ml
index 88b13abf9..0e6d346a3 100644
--- a/plugins/micromega/persistent_cache.ml
+++ b/plugins/micromega/persistent_cache.ml
@@ -92,7 +92,7 @@ let read_key_elem inch =
     Some (Marshal.from_channel inch)
   with
     | End_of_file -> None
-    | e when Errors.noncritical e -> raise InvalidTableFormat
+    | e when CErrors.noncritical e -> raise InvalidTableFormat
 
 (** 
     We used to only lock/unlock regions.
diff --git a/plugins/micromega/vo.itarget b/plugins/micromega/vo.itarget
index bf6a1a7db..c9009ea4d 100644
--- a/plugins/micromega/vo.itarget
+++ b/plugins/micromega/vo.itarget
@@ -10,4 +10,6 @@ Tauto.vo
 VarMap.vo
 ZCoeff.vo
 ZMicromega.vo
-Lia.vo
\ No newline at end of file
+Lia.vo
+Lqa.vo
+Lra.vo
diff --git a/plugins/nsatz/Nsatz.v b/plugins/nsatz/Nsatz.v
index 3068b5347..b11d15e5c 100644
--- a/plugins/nsatz/Nsatz.v
+++ b/plugins/nsatz/Nsatz.v
@@ -298,7 +298,9 @@ Ltac nsatz_call_n info nparam p rr lp kont :=
   match goal with
   | |- (?c::PEpow _ ?r::?lq0)::?lci0 = _ -> _ =>
     intros _;
+    let lci := fresh "lci" in
     set (lci:=lci0);
+    let lq := fresh "lq" in
     set (lq:=lq0);
     kont c rr lq lci
   end.
@@ -380,10 +382,13 @@ Ltac nsatz_generic radicalmax info lparam lvar :=
     end in 
 
   SplitPolyList ltac:(fun p lp =>
+    let p21 := fresh "p21" in
+    let lp21 := fresh "lp21" in
     set (p21:=p) ;
     set (lp21:=lp);
 (*    idtac "nparam:"; idtac nparam; idtac "p:"; idtac p; idtac "lp:"; idtac lp; *)
     nsatz_call radicalmax info nparam p lp ltac:(fun c r lq lci => 
+      let q := fresh "q" in
       set (q := PEmul c (PEpow p21 r)); 
       let Hg := fresh "Hg" in 
       assert (Hg:check lp21 q (lci,lq) = true); 
diff --git a/plugins/nsatz/ideal.ml b/plugins/nsatz/ideal.ml
index 482ce5053..48bdad826 100644
--- a/plugins/nsatz/ideal.ml
+++ b/plugins/nsatz/ideal.ml
@@ -19,75 +19,6 @@ open Utile
 
 exception NotInIdeal
 
-module type S = sig
-
-(* Monomials *)
-type mon = int array
-
-val mult_mon : mon -> mon -> mon
-val deg : mon -> int
-val compare_mon : mon -> mon -> int
-val div_mon : mon -> mon -> mon
-val div_mon_test : mon -> mon -> bool
-val ppcm_mon : mon -> mon -> mon
-
-(* Polynomials *)
-
-type deg = int
-type coef
-type poly
-type polynom 
-
-val repr : poly -> (coef * mon) list
-val polconst : coef -> poly
-val zeroP : poly
-val gen : int -> poly
-
-val equal : poly -> poly -> bool
-val name_var : string list ref
-val getvar : string list -> int -> string
-val lstringP : poly list -> string
-val printP : poly -> unit
-val lprintP : poly list -> unit
-
-val div_pol_coef : poly -> coef -> poly
-val plusP : poly -> poly -> poly
-val mult_t_pol : coef -> mon -> poly -> poly
-val selectdiv : mon -> poly list -> poly
-val oppP : poly -> poly
-val emultP : coef -> poly -> poly
-val multP : poly -> poly -> poly
-val puisP : poly -> int -> poly
-val contentP : poly -> coef
-val contentPlist : poly list -> coef
-val pgcdpos : coef -> coef -> coef
-val div_pol : poly -> poly -> coef -> coef -> mon -> poly
-val reduce2 : poly -> poly list -> coef * poly
-
-val poldepcontent : coef list ref
-val coefpoldep_find : poly -> poly -> poly
-val coefpoldep_set : poly -> poly -> poly -> unit
-val initcoefpoldep : poly list -> unit
-val reduce2_trace : poly -> poly list -> poly list -> poly list * poly
-val spol : poly -> poly -> poly
-val etrangers : poly -> poly -> bool
-val div_ppcm : poly -> poly -> poly -> bool
-
-val genPcPf : poly -> poly list -> poly list -> poly list
-val genOCPf : poly list -> poly list
-
-val is_homogeneous : poly -> bool
-
-type certificate =
-    { coef : coef; power : int;
-      gb_comb : poly list list; last_comb : poly list }
-
-val test_dans_ideal : poly -> poly list -> poly list ->
-  poly list * poly * certificate
-val in_ideal : deg -> poly list -> poly -> poly list * poly * certificate
-
-end
-
 (***********************************************************************
    Global options
 *)
@@ -127,11 +58,11 @@ type polynom =
     num : int;
     sugar : int}
 
-let nvar m =  Array.length m - 1
+let nvar (m : mon) =  Array.length m - 1
 
-let deg m = m.(0)
+let deg (m : mon) = m.(0)
 
-let mult_mon m m' =
+let mult_mon (m : mon) (m' : mon) =
   let d = nvar m in
   let m'' = Array.make (d+1) 0 in
   for i=0 to d do
@@ -140,7 +71,7 @@ let mult_mon m m' =
   m''
 
 
-let compare_mon m m' =
+let compare_mon (m : mon) (m' : mon) =
   let d = nvar m in
   if !lexico
   then (
@@ -148,18 +79,18 @@ let compare_mon m m' =
     let res=ref 0 in
     let i=ref 1 in (* 1 si lexico pur 0 si degre*)
     while (!res=0) && (!i<=d) do
-      res:= (compare m.(!i) m'.(!i));
+      res:= (Int.compare m.(!i) m'.(!i));
       i:=!i+1;
     done;
     !res)
   else (
      (* degre lexicographique inverse *)
-    match compare m.(0) m'.(0) with
+    match Int.compare m.(0) m'.(0) with
     | 0 -> (* meme degre total *)
 	let res=ref 0 in
 	let i=ref d in
 	while (!res=0) && (!i>=1) do
-	  res:= - (compare m.(!i) m'.(!i));
+	  res:= - (Int.compare m.(!i) m'.(!i));
 	  i:=!i-1;
 	done;
 	!res
@@ -402,29 +333,25 @@ let polconst d c =
   [(c,m)]
 
 let plusP p q =
-  let rec plusP p q =
-    match p with
-      [] -> q
-    |t::p' -> 
-	match q with
-	  [] -> p
-	|t'::q' ->
-            match compare_mon (snd t) (snd t') with
-              1 -> t::(plusP p' q)
-            |(-1) -> t'::(plusP p q')
-            |_ -> let c=P.plusP (fst t) (fst t') in
-              match P.equal c coef0 with
-                true -> (plusP p' q')
-              |false -> (c,(snd t))::(plusP p' q')
-  in plusP p q
+  let rec plusP p q accu = match p, q with
+  | [], [] -> List.rev accu
+  | [], _ -> List.rev_append accu q
+  | _, [] -> List.rev_append accu p
+  | t :: p', t' :: q' ->
+    let c = compare_mon (snd t) (snd t') in
+    if c > 0 then plusP p' q (t :: accu)
+    else if c < 0 then plusP p q' (t' :: accu)
+    else
+      let c = P.plusP (fst t) (fst t') in
+      if P.equal c coef0 then plusP p' q' accu
+      else plusP p' q' ((c, (snd t)) :: accu)
+  in
+  plusP p q []
 
 (* multiplication by (a,monomial) *)
 let mult_t_pol a m p =
-  let rec mult_t_pol p =
-    match p with
-      [] -> []
-    |(b,m')::p -> ((P.multP a b),(mult_mon m m'))::(mult_t_pol p)
-  in mult_t_pol p
+  let map (b, m') = (P.multP a b, mult_mon m m') in
+  CList.map map p
 
 let coef_of_int x = P.of_num (Num.Int x)
 
@@ -451,23 +378,27 @@ let emultP a p =
   in emultP p
 
 let multP p q =
-  let rec aux p =
+  let rec aux p accu =
     match p with
-      [] -> []
-    |(a,m)::p' -> plusP (mult_t_pol a m q) (aux p')
-  in aux p
+      [] -> accu
+    |(a,m)::p' -> aux p' (plusP (mult_t_pol a m q) accu)
+  in aux p []
 
 let puisP p n=
   match p with
     [] -> []
   |_ ->
+    if n = 0 then
       let d = nvar (snd (List.hd p)) in
-      let rec puisP n =
-	match n with
-	  0 -> [coef1, Array.make (d+1) 0]
-	| 1 -> p
-	|_ -> multP p (puisP (n-1))
-      in puisP n
+      [coef1, Array.make (d+1) 0]
+    else
+      let rec puisP p n =
+        if n = 1 then p
+        else
+          let q = puisP p (n / 2) in
+          let q = multP q q in
+          if n mod 2 = 0 then q else multP p q
+      in puisP p n
 	
 let rec contentP p =
   match p with
diff --git a/plugins/nsatz/ideal.mli b/plugins/nsatz/ideal.mli
new file mode 100644
index 000000000..d1a2a0a7d
--- /dev/null
+++ b/plugins/nsatz/ideal.mli
@@ -0,0 +1,47 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+module Make (P : Polynom.S) :
+sig
+(* Polynomials *)
+
+type deg = int
+type coef = P.t
+type poly
+
+val repr : poly -> (coef * int array) list
+val polconst : int -> coef -> poly
+val zeroP : poly
+val gen : int -> int -> poly
+
+val equal : poly -> poly -> bool
+val name_var : string list ref
+
+val plusP : poly -> poly -> poly
+val oppP : poly -> poly
+val multP : poly -> poly -> poly
+val puisP : poly -> int -> poly
+
+val poldepcontent : coef list ref
+
+type certificate =
+    { coef : coef; power : int;
+      gb_comb : poly list list; last_comb : poly list }
+
+val in_ideal : deg -> poly list -> poly -> poly list * poly * certificate
+
+module Hashpol : Hashtbl.S with type key = poly
+
+val sugar_flag : bool ref
+val divide_rem_with_critical_pair : bool ref
+
+end
+
+exception NotInIdeal
+
+val lexico : bool ref
diff --git a/plugins/nsatz/nsatz.ml b/plugins/nsatz/nsatz.ml
index ee1904a66..36bce780b 100644
--- a/plugins/nsatz/nsatz.ml
+++ b/plugins/nsatz/nsatz.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-open Errors
+open CErrors
 open Util
 open Term
 open Tactics
@@ -468,6 +468,44 @@ let theoremedeszeros lpol p =
 
 open Ideal
 
+(* Remove zero polynomials and duplicates from the list of polynomials lp
+   Return (clp, lb)
+   where clp is the reduced list and lb is a list of booleans
+   that has the same size than lp and where true indicates an
+   element that has been removed
+ *)
+let rec clean_pol lp =
+  let t = Hashpol.create 12 in
+  let find p = try Hashpol.find t p 
+               with 
+                 Not_found -> Hashpol.add t p true; false in
+  let rec aux lp =
+    match lp with
+    | [] -> [], []
+    | p :: lp1 -> 
+      let clp, lb = aux lp1 in
+      if equal p zeroP ||  find p then clp, true::lb 
+       else
+        (p :: clp, false::lb) in
+     aux lp
+
+(* Expand the list of polynomials lp putting zeros where the list of 
+   booleans lb indicates there is a missing element 
+   Warning:
+   the expansion is relative to the end of the list in reversed order
+   lp cannot have less elements than lb
+*)
+let expand_pol lb lp =
+ let rec aux lb lp = 
+   match lb with
+   | [] -> lp
+   | true :: lb1 ->  zeroP :: aux lb1 lp
+   | false :: lb1 ->
+     match lp with
+     [] -> assert false
+     | p :: lp1 -> p :: aux lb1 lp1 
+  in List.rev (aux lb (List.rev lp))
+
 let theoremedeszeros_termes lp =
   nvars:=0;(* mise a jour par term_pol_sparse *)
   List.iter set_nvars_term  lp;
@@ -518,20 +556,29 @@ let theoremedeszeros_termes lp =
       | [] -> assert false
       | p::lp1 ->
 	  let lpol = List.rev lp1 in
+          (* preprocessing :
+             we remove zero polynomials and duplicate that are not handled by in_ideal
+             lb is kept in order to fix the certificate in the post-processing 
+          *)
+	  let lpol, lb  = clean_pol lpol in
 	  let (cert,lp0,p,_lct) = theoremedeszeros lpol p in
           info "cert ok\n";
 	  let lc = cert.last_comb::List.rev cert.gb_comb in
 	  match remove_zeros (fun x -> equal x zeroP) lc with
 	  | [] -> assert false
 	  | (lq::lci) ->
+              (* post-processing : we apply the correction for the last line *)
+              let lq = expand_pol lb lq in
 	      (* lci commence par les nouveaux polynomes *)
-	      let m= !nvars in
+	      let m = !nvars in
 	      let c = pol_sparse_to_term m (polconst m cert.coef) in
 	      let r = Pow(Zero,cert.power) in
 	      let lci = List.rev lci in
+              (* post-processing we apply the correction for the other lines *)
+	      let lci = List.map (expand_pol lb) lci in
 	      let lci = List.map (List.map (pol_sparse_to_term m)) lci in
 	      let lq = List.map (pol_sparse_to_term m) lq in
-	      info ("number of parametres: "^string_of_int nparam^"\n");
+	      info ("number of parameters: "^string_of_int nparam^"\n");
 	      info "term computed\n";
 	      (c,r,lci,lq)
       )
diff --git a/plugins/nsatz/nsatz.mli b/plugins/nsatz/nsatz.mli
new file mode 100644
index 000000000..e876ccfa5
--- /dev/null
+++ b/plugins/nsatz/nsatz.mli
@@ -0,0 +1,9 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+val nsatz_compute : Constr.t -> unit Proofview.tactic
diff --git a/plugins/nsatz/nsatz_plugin.mllib b/plugins/nsatz/nsatz_plugin.mlpack
index e991fb76f..b55adf43c 100644
--- a/plugins/nsatz/nsatz_plugin.mllib
+++ b/plugins/nsatz/nsatz_plugin.mlpack
@@ -3,4 +3,3 @@ Polynom
 Ideal
 Nsatz
 G_nsatz
-Nsatz_plugin_mod
diff --git a/plugins/nsatz/utile.ml b/plugins/nsatz/utile.ml
index 8e2fc07c0..922432460 100644
--- a/plugins/nsatz/utile.ml
+++ b/plugins/nsatz/utile.ml
@@ -51,7 +51,7 @@ let facteurs_liste div constant lp =
                                    if not (constant r)
 				   then l1:=r::(!l1)
                                    else p_dans_lmin:=true)
-			      with e when Errors.noncritical e -> ())
+			      with e when CErrors.noncritical e -> ())
                      lmin;
           if !p_dans_lmin
           then factor lmin lp1
@@ -62,7 +62,7 @@ let facteurs_liste div constant lp =
                 List.iter (fun q -> try (let r = div q p in
 					 if not (constant r)
 					 then l1:=r::(!l1))
-				    with e when Errors.noncritical e ->
+				    with e when CErrors.noncritical e ->
                                       lmin1:=q::(!lmin1))
                           lmin;
 	        factor (List.rev (p::(!lmin1))) !l1)
@@ -93,7 +93,7 @@ let factorise_tableau div zero c f l1 =
       	                       li:=j::(!li);
                                r:=rr;
 			   done)
-                      with e when Errors.noncritical e -> ())
+                      with e when CErrors.noncritical e -> ())
                   l1;
       res.(i)<-(!r,!li))
      f;
diff --git a/plugins/omega/coq_omega.ml b/plugins/omega/coq_omega.ml
index 0bf30e7fd..1afc6500b 100644
--- a/plugins/omega/coq_omega.ml
+++ b/plugins/omega/coq_omega.ml
@@ -13,7 +13,7 @@
 (*                                                                        *)
 (**************************************************************************)
 
-open Errors
+open CErrors
 open Util
 open Names
 open Nameops
@@ -30,6 +30,7 @@ open Misctypes
 open Proofview.Notations
 open Context.Named.Declaration
 
+module NamedDecl = Context.Named.Declaration
 module OmegaSolver = Omega.MakeOmegaSolver (Bigint)
 open OmegaSolver
 
@@ -911,7 +912,7 @@ let rec transform p t =
     try
       let v,th,_ = find_constr t' in
       [clever_rewrite_base p (mkVar v) (mkVar th)], Oatom v
-    with e when Errors.noncritical e ->
+    with e when CErrors.noncritical e ->
       let v = new_identifier_var ()
       and th = new_identifier () in
       hide_constr t' v th isnat;
@@ -951,7 +952,7 @@ let rec transform p t =
        end
    | Kapp((Zpos|Zneg|Z0),_) ->
        (try ([],Oz(recognize_number t))
-        with e when Errors.noncritical e -> default false t)
+        with e when CErrors.noncritical e -> default false t)
    | Kvar s -> [],Oatom s
    | Kapp(Zopp,[t]) ->
        let tac,t' = transform (P_APP 1 :: p) t in
@@ -1697,8 +1698,8 @@ let destructure_hyps =
     let rec loop = function
       | [] -> (Tacticals.New.tclTHEN nat_inject coq_omega)
       | decl::lit ->
-          let (i,_,t) = to_tuple decl in
-	  begin try match destructurate_prop t with
+          let i = NamedDecl.get_id decl in
+	  begin try match destructurate_prop (NamedDecl.get_type decl) with
 	  | Kapp(False,[]) -> elim_id i
           | Kapp((Zle|Zge|Zgt|Zlt|Zne),[t1;t2]) -> loop lit
           | Kapp(Or,[t1;t2]) ->
@@ -1808,13 +1809,13 @@ let destructure_hyps =
 		    match destructurate_type (pf_nf typ) with
 		    | Kapp(Nat,_) ->
                         (Tacticals.New.tclTHEN
-			   (convert_hyp_no_check (set_type (mkApp (Lazy.force coq_neq, [| t1;t2|]))
-                                                           decl))
+			   (convert_hyp_no_check (NamedDecl.set_type (mkApp (Lazy.force coq_neq, [| t1;t2|]))
+                                                                     decl))
 			   (loop lit))
 		    | Kapp(Z,_) ->
                         (Tacticals.New.tclTHEN
-			   (convert_hyp_no_check (set_type (mkApp (Lazy.force coq_Zne, [| t1;t2|]))
-                                                           decl))
+			   (convert_hyp_no_check (NamedDecl.set_type (mkApp (Lazy.force coq_Zne, [| t1;t2|]))
+                                                                     decl))
 			   (loop lit))
 		    | _ -> loop lit
                   end
diff --git a/plugins/omega/g_omega.ml4 b/plugins/omega/g_omega.ml4
index d7538146f..27115abec 100644
--- a/plugins/omega/g_omega.ml4
+++ b/plugins/omega/g_omega.ml4
@@ -19,7 +19,7 @@ DECLARE PLUGIN "omega_plugin"
 
 open Names
 open Coq_omega
-open Constrarg
+open Stdarg
 
 let eval_tactic name =
   let dp = DirPath.make (List.map Id.of_string ["PreOmega"; "omega"; "Coq"]) in
@@ -34,7 +34,7 @@ let omega_tactic l =
        | "positive" -> eval_tactic "zify_positive"
        | "N" -> eval_tactic "zify_N"
        | "Z" -> eval_tactic "zify_op"
-       | s -> Errors.error ("No Omega knowledge base for type "^s))
+       | s -> CErrors.error ("No Omega knowledge base for type "^s))
     (Util.List.sort_uniquize String.compare l)
   in
   Tacticals.New.tclTHEN
diff --git a/plugins/omega/omega_plugin.mllib b/plugins/omega/omega_plugin.mlpack
index 2b387fdce..df7f1047f 100644
--- a/plugins/omega/omega_plugin.mllib
+++ b/plugins/omega/omega_plugin.mlpack
@@ -1,4 +1,3 @@
 Omega
 Coq_omega
 G_omega
-Omega_plugin_mod
diff --git a/plugins/plugins.itarget b/plugins/plugins.itarget
deleted file mode 100644
index 56aa42b06..000000000
--- a/plugins/plugins.itarget
+++ /dev/null
@@ -1,3 +0,0 @@
-pluginsopt.otarget
-pluginsbyte.otarget
-pluginsvo.otarget
\ No newline at end of file
diff --git a/plugins/pluginsbyte.itarget b/plugins/pluginsbyte.itarget
deleted file mode 100644
index d8752f8b8..000000000
--- a/plugins/pluginsbyte.itarget
+++ /dev/null
@@ -1,21 +0,0 @@
-btauto/btauto_plugin.cma
-setoid_ring/newring_plugin.cma
-extraction/extraction_plugin.cma
-decl_mode/decl_mode_plugin.cma
-firstorder/ground_plugin.cma
-rtauto/rtauto_plugin.cma
-fourier/fourier_plugin.cma
-romega/romega_plugin.cma
-omega/omega_plugin.cma
-micromega/micromega_plugin.cma
-cc/cc_plugin.cma
-nsatz/nsatz_plugin.cma
-funind/recdef_plugin.cma
-syntax/ascii_syntax_plugin.cma
-syntax/nat_syntax_plugin.cma
-syntax/numbers_syntax_plugin.cma
-syntax/r_syntax_plugin.cma
-syntax/string_syntax_plugin.cma
-syntax/z_syntax_plugin.cma
-quote/quote_plugin.cma
-derive/derive_plugin.cma
\ No newline at end of file
diff --git a/plugins/pluginsdyn.itarget b/plugins/pluginsdyn.itarget
deleted file mode 100644
index 220e5182d..000000000
--- a/plugins/pluginsdyn.itarget
+++ /dev/null
@@ -1,24 +0,0 @@
-btauto/btauto_plugin.cmxs
-field/field_plugin.cmxs
-setoid_ring/newring_plugin.cmxs
-extraction/extraction_plugin.cmxs
-decl_mode/decl_mode_plugin.cmxs
-firstorder/ground_plugin.cmxs
-rtauto/rtauto_plugin.cmxs
-fourier/fourier_plugin.cmxs
-romega/romega_plugin.cmxs
-omega/omega_plugin.cmxs
-micromega/micromega_plugin.cmxs
-subtac/subtac_plugin.cmxs
-ring/ring_plugin.cmxs
-cc/cc_plugin.cmxs
-nsatz/nsatz_plugin.cmxs
-funind/recdef_plugin.cmxs
-syntax/ascii_syntax_plugin.cmxs
-syntax/nat_syntax_plugin.cmxs
-syntax/numbers_syntax_plugin.cmxs
-syntax/r_syntax_plugin.cmxs
-syntax/string_syntax_plugin.cmxs
-syntax/z_syntax_plugin.cmxs
-quote/quote_plugin.cmxs
-derive/derive_plugin.cmxs
diff --git a/plugins/pluginsopt.itarget b/plugins/pluginsopt.itarget
deleted file mode 100644
index 04a1e711c..000000000
--- a/plugins/pluginsopt.itarget
+++ /dev/null
@@ -1,21 +0,0 @@
-btauto/btauto_plugin.cmxa
-setoid_ring/newring_plugin.cmxa
-extraction/extraction_plugin.cmxa
-decl_mode/decl_mode_plugin.cmxa
-firstorder/ground_plugin.cmxa
-rtauto/rtauto_plugin.cmxa
-fourier/fourier_plugin.cmxa
-romega/romega_plugin.cmxa
-omega/omega_plugin.cmxa
-micromega/micromega_plugin.cmxa
-cc/cc_plugin.cmxa
-nsatz/nsatz_plugin.cmxa
-funind/recdef_plugin.cmxa
-syntax/ascii_syntax_plugin.cmxa
-syntax/nat_syntax_plugin.cmxa
-syntax/numbers_syntax_plugin.cmxa
-syntax/r_syntax_plugin.cmxa
-syntax/string_syntax_plugin.cmxa
-syntax/z_syntax_plugin.cmxa
-quote/quote_plugin.cmxa
-derive/derive_plugin.cmxa
diff --git a/plugins/pluginsvo.itarget b/plugins/pluginsvo.itarget
deleted file mode 100644
index a59bf29c9..000000000
--- a/plugins/pluginsvo.itarget
+++ /dev/null
@@ -1,12 +0,0 @@
-btauto/vo.otarget
-fourier/vo.otarget
-funind/vo.otarget
-nsatz/vo.otarget
-micromega/vo.otarget
-omega/vo.otarget
-quote/vo.otarget
-romega/vo.otarget
-rtauto/vo.otarget
-setoid_ring/vo.otarget
-extraction/vo.otarget
-derive/vo.otarget
\ No newline at end of file
diff --git a/plugins/quote/g_quote.ml4 b/plugins/quote/g_quote.ml4
index fd87d5b7d..e7e6ecef9 100644
--- a/plugins/quote/g_quote.ml4
+++ b/plugins/quote/g_quote.ml4
@@ -13,7 +13,8 @@ open Misctypes
 open Tacexpr
 open Geninterp
 open Quote
-open Constrarg
+open Stdarg
+open Tacarg
 
 DECLARE PLUGIN "quote_plugin"
 
diff --git a/plugins/quote/quote.ml b/plugins/quote/quote.ml
index dbd7460e2..6405c8ceb 100644
--- a/plugins/quote/quote.ml
+++ b/plugins/quote/quote.ml
@@ -101,7 +101,7 @@
 
 
 (*i*)
-open Errors
+open CErrors
 open Util
 open Names
 open Term
@@ -183,7 +183,7 @@ type inversion_scheme = {
 
 let i_can't_do_that () = error "Quote: not a simple fixpoint"
 
-let decomp_term c = kind_of_term (strip_outer_cast c)
+let decomp_term c = kind_of_term (Termops.strip_outer_cast c)
 
 (*s [compute_lhs typ i nargsi] builds the term \texttt{(C ?nargsi ...
   ?2 ?1)}, where \texttt{C} is the [i]-th constructor of inductive
diff --git a/plugins/quote/quote_plugin.mllib b/plugins/quote/quote_plugin.mllib
deleted file mode 100644
index d1b3ccbe1..000000000
--- a/plugins/quote/quote_plugin.mllib
+++ /dev/null
@@ -1,3 +0,0 @@
-Quote
-G_quote
-Quote_plugin_mod
diff --git a/plugins/quote/quote_plugin.mlpack b/plugins/quote/quote_plugin.mlpack
new file mode 100644
index 000000000..2e9be09d8
--- /dev/null
+++ b/plugins/quote/quote_plugin.mlpack
@@ -0,0 +1,2 @@
+Quote
+G_quote
diff --git a/plugins/romega/ReflOmegaCore.v b/plugins/romega/ReflOmegaCore.v
index 36511386a..187601fc6 100644
--- a/plugins/romega/ReflOmegaCore.v
+++ b/plugins/romega/ReflOmegaCore.v
@@ -1074,16 +1074,19 @@ Qed.
    avait utilisé le test précédent et fait une elimination dessus. *)
 
 Ltac elim_eq_term t1 t2 :=
+  let Aux := fresh "Aux" in
   pattern (eq_term t1 t2); apply bool_eq_ind; intro Aux;
    [ generalize (eq_term_true t1 t2 Aux); clear Aux
    | generalize (eq_term_false t1 t2 Aux); clear Aux ].
 
 Ltac elim_beq t1 t2 :=
+  let Aux := fresh "Aux" in
   pattern (beq t1 t2); apply bool_eq_ind; intro Aux;
    [ generalize (beq_true t1 t2 Aux); clear Aux
    | generalize (beq_false t1 t2 Aux); clear Aux ].
 
 Ltac elim_bgt t1 t2 :=
+  let Aux := fresh "Aux" in
   pattern (bgt t1 t2); apply bool_eq_ind; intro Aux;
   [ generalize (bgt_true t1 t2 Aux); clear Aux
   | generalize (bgt_false t1 t2 Aux); clear Aux ].
@@ -1448,27 +1451,27 @@ Ltac loop t :=
   | (Tint ?X1) => loop X1
   (* Eliminations *)
   | match ?X1 with
-    | EqTerm x x0 => _
-    | LeqTerm x x0 => _
+    | EqTerm _ _ => _
+    | LeqTerm _ _ => _
     | TrueTerm => _
     | FalseTerm => _
-    | Tnot x => _
-    | GeqTerm x x0 => _
-    | GtTerm x x0 => _
-    | LtTerm x x0 => _
-    | NeqTerm x x0 => _
-    | Tor x x0 => _
-    | Tand x x0 => _
-    | Timp x x0 => _
-    | Tprop x => _
+    | Tnot _ => _
+    | GeqTerm _ _ => _
+    | GtTerm _ _ => _
+    | LtTerm _ _ => _
+    | NeqTerm _ _ => _
+    | Tor _ _ => _
+    | Tand _ _ => _
+    | Timp _ _ => _
+    | Tprop _ => _
     end => destruct X1; auto; Simplify
   | match ?X1 with
-    | Tint x => _
-    | (x + x0)%term => _
-    | (x * x0)%term => _
-    | (x - x0)%term => _
-    | (- x)%term => _
-    | [x]%term => _
+    | Tint _ => _
+    | (_ + _)%term => _
+    | (_ * _)%term => _
+    | (_ - _)%term => _
+    | (- _)%term => _
+    | [_]%term => _
     end => destruct X1; auto; Simplify
   | (if beq ?X1 ?X2 then _ else _) =>
       let H := fresh "H" in
diff --git a/plugins/romega/const_omega.ml b/plugins/romega/const_omega.ml
index 21b0f78b5..4935fe4bb 100644
--- a/plugins/romega/const_omega.ml
+++ b/plugins/romega/const_omega.ml
@@ -39,7 +39,7 @@ let destructurate t =
     | Term.Var id,[] -> Kvar(Names.Id.to_string id)
     | Term.Prod (Names.Anonymous,typ,body), [] -> Kimp(typ,body)
     | Term.Prod (Names.Name _,_,_),[] ->
-	Errors.error "Omega: Not a quantifier-free goal"
+	CErrors.error "Omega: Not a quantifier-free goal"
     | _ -> Kufo
 
 exception Destruct
@@ -346,7 +346,7 @@ let parse_term t =
     | Kapp("Z.succ",[t]) -> Tsucc t
     | Kapp("Z.pred",[t]) -> Tplus(t, mk_Z (Bigint.neg Bigint.one))
     | Kapp(("Zpos"|"Zneg"|"Z0"),_) ->
-	(try Tnum (recognize t) with e when Errors.noncritical e -> Tother)
+	(try Tnum (recognize t) with e when CErrors.noncritical e -> Tother)
     | _ -> Tother
   with e when Logic.catchable_exception e -> Tother
 
@@ -368,6 +368,6 @@ let is_scalar t =
     | Kapp(("Z.opp"|"Z.succ"|"Z.pred"),[t]) -> aux t
     | Kapp(("Zpos"|"Zneg"|"Z0"),_) -> let _ = recognize t in true
     | _ -> false in
-  try aux t with e when Errors.noncritical e -> false
+  try aux t with e when CErrors.noncritical e -> false
 
 end
diff --git a/plugins/romega/g_romega.ml4 b/plugins/romega/g_romega.ml4
index fd4ede6c3..2f38688d1 100644
--- a/plugins/romega/g_romega.ml4
+++ b/plugins/romega/g_romega.ml4
@@ -12,7 +12,7 @@ DECLARE PLUGIN "romega_plugin"
 
 open Names
 open Refl_omega
-open Constrarg
+open Stdarg
 
 let eval_tactic name =
   let dp = DirPath.make (List.map Id.of_string ["PreOmega"; "omega"; "Coq"]) in
@@ -27,7 +27,7 @@ let romega_tactic l =
        | "positive" -> eval_tactic "zify_positive"
        | "N" -> eval_tactic "zify_N"
        | "Z" -> eval_tactic "zify_op"
-       | s -> Errors.error ("No ROmega knowledge base for type "^s))
+       | s -> CErrors.error ("No ROmega knowledge base for type "^s))
     (Util.List.sort_uniquize String.compare l)
   in
   Tacticals.New.tclTHEN
diff --git a/plugins/romega/refl_omega.ml b/plugins/romega/refl_omega.ml
index 007a9ec67..ba882e39a 100644
--- a/plugins/romega/refl_omega.ml
+++ b/plugins/romega/refl_omega.ml
@@ -9,7 +9,7 @@
 open Pp
 open Util
 open Const_omega
-module OmegaSolver = Omega.MakeOmegaSolver (Bigint)
+module OmegaSolver = Omega_plugin.Omega.MakeOmegaSolver (Bigint)
 open OmegaSolver
 
 (* \section{Useful functions and flags} *)
@@ -454,7 +454,7 @@ let rec scalar n = function
  | Omult(t1,Oint x) ->
      do_list [Lazy.force coq_c_mult_assoc_reduced], Omult(t1,Oint (n*x))
  | Omult(t1,t2) ->
-     Errors.error "Omega: Can't solve a goal with non-linear products"
+     CErrors.error "Omega: Can't solve a goal with non-linear products"
  | (Oatom _ as t) -> do_list [], Omult(t,Oint n)
  | Oint i -> do_list [Lazy.force coq_c_reduce],Oint(n*i)
  | (Oufo _ as t)-> do_list [], Oufo (Omult(t,Oint n))
@@ -473,7 +473,7 @@ let rec negate = function
  | Omult(t1,Oint x) ->
      do_list [Lazy.force coq_c_opp_mult_r], Omult(t1,Oint (Bigint.neg x))
  | Omult(t1,t2) ->
-     Errors.error "Omega: Can't solve a goal with non-linear products"
+     CErrors.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(negone))
  | Oint i -> do_list [Lazy.force coq_c_reduce] ,Oint(Bigint.neg i)
@@ -545,7 +545,7 @@ let shrink_pair f1 f2 =
        Lazy.force coq_c_red4, Omult(Oatom v,Oplus(c1,c2))
    | t1,t2 ->
        oprint stdout t1; print_newline (); oprint stdout t2; print_newline ();
-       flush Pervasives.stdout; Errors.error "shrink.1"
+       flush Pervasives.stdout; CErrors.error "shrink.1"
   end
 
 (* \subsection{Calcul d'une sous formule constante} *)
@@ -559,9 +559,9 @@ let reduce_factor = function
       let rec compute = function
           Oint n -> n
 	| Oplus(t1,t2) -> compute t1 + compute t2
-	| _ -> Errors.error "condense.1" in
+	| _ -> CErrors.error "condense.1" in
 	[Lazy.force coq_c_reduce], Omult(Oatom v,Oint(compute c))
-  | t -> Errors.error "reduce_factor.1"
+  | t -> CErrors.error "reduce_factor.1"
 
 (* \subsection{Réordonnancement} *)
 
@@ -1304,7 +1304,7 @@ let total_reflexive_omega_tactic gl =
   let systems_list = destructurate_hyps full_reified_goal in
   if !debug then display_systems systems_list;
   resolution env full_reified_goal systems_list gl
-  with NO_CONTRADICTION -> Errors.error "ROmega can't solve this system"
+  with NO_CONTRADICTION -> CErrors.error "ROmega can't solve this system"
 
 
 (*i let tester = Tacmach.hide_atomic_tactic "TestOmega" test_tactic i*)
diff --git a/plugins/romega/romega_plugin.mllib b/plugins/romega/romega_plugin.mlpack
index 1625009d0..38d0e9411 100644
--- a/plugins/romega/romega_plugin.mllib
+++ b/plugins/romega/romega_plugin.mlpack
@@ -1,4 +1,3 @@
 Const_omega
 Refl_omega
 G_romega
-Romega_plugin_mod
diff --git a/plugins/rtauto/Bintree.v b/plugins/rtauto/Bintree.v
index 7394cebde..364601871 100644
--- a/plugins/rtauto/Bintree.v
+++ b/plugins/rtauto/Bintree.v
@@ -266,7 +266,7 @@ 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 Pos.succ_not_1.
+intros [= H%Pos.succ_not_1]. assumption.
 Qed.
 
 Fixpoint In (x:A) (S:Store) (F:Full S) {struct F}: Prop :=
diff --git a/plugins/rtauto/proof_search.ml b/plugins/rtauto/proof_search.ml
index f3eae5f50..8b9261113 100644
--- a/plugins/rtauto/proof_search.ml
+++ b/plugins/rtauto/proof_search.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-open Errors
+open CErrors
 open Util
 open Goptions
 
diff --git a/plugins/rtauto/refl_tauto.ml b/plugins/rtauto/refl_tauto.ml
index 0a0b45915..367a13333 100644
--- a/plugins/rtauto/refl_tauto.ml
+++ b/plugins/rtauto/refl_tauto.ml
@@ -8,7 +8,7 @@
 
 module Search = Explore.Make(Proof_search)
 
-open Errors
+open CErrors
 open Util
 open Term
 open Tacmach
@@ -67,12 +67,12 @@ 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 infos=CClosure.create_clos_infos CClosure.all (pf_env gl) in
+    (fun t -> CClosure.whd_val infos (CClosure.inject t))
 
 let special_nf gl=
-  let infos=Closure.create_clos_infos Closure.betaiotazeta (pf_env gl) in
-    (fun t -> Closure.norm_val infos (Closure.inject t))
+  let infos=CClosure.create_clos_infos CClosure.betaiotazeta (pf_env gl) in
+    (fun t -> CClosure.norm_val infos (CClosure.inject t))
 
 type atom_env=
     {mutable next:int;
@@ -263,7 +263,7 @@ let rtauto_tac gls=
   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
+    then user_err ~hdr:"rtauto" (Pp.str "goal should be in Prop") in
   let glf=make_form gamma gls gl in
   let hyps=make_hyps gamma gls [gl] (pf_hyps gls) in
   let formula=
@@ -282,7 +282,7 @@ let rtauto_tac gls=
   let prf =
     try project (search_fun (init_state [] formula))
     with Not_found ->
-      errorlabstrm "rtauto" (Pp.str "rtauto couldn't find any proof") in
+      user_err ~hdr:"rtauto" (Pp.str "rtauto couldn't find any proof") in
   let search_end_time = System.get_time () in
   let _ = if !verbose then
     begin
diff --git a/plugins/rtauto/rtauto_plugin.mllib b/plugins/rtauto/rtauto_plugin.mlpack
index 0e3460449..61c5e945b 100644
--- a/plugins/rtauto/rtauto_plugin.mllib
+++ b/plugins/rtauto/rtauto_plugin.mlpack
@@ -1,4 +1,3 @@
 Proof_search
 Refl_tauto
 G_rtauto
-Rtauto_plugin_mod
diff --git a/plugins/setoid_ring/InitialRing.v b/plugins/setoid_ring/InitialRing.v
index 8fcc07716..9c690e2b4 100644
--- a/plugins/setoid_ring/InitialRing.v
+++ b/plugins/setoid_ring/InitialRing.v
@@ -96,7 +96,7 @@ Section ZMORPHISM.
  Proof.
   constructor.
   destruct c;intros;try discriminate.
-  injection H;clear H;intros H1;subst c'.
+  injection H as <-.
   simpl. unfold Zeq_bool. rewrite Z.compare_refl. trivial.
  Qed.
 
diff --git a/plugins/setoid_ring/Ncring_initial.v b/plugins/setoid_ring/Ncring_initial.v
index 96885d2f7..20022c00e 100644
--- a/plugins/setoid_ring/Ncring_initial.v
+++ b/plugins/setoid_ring/Ncring_initial.v
@@ -18,7 +18,6 @@ Require Import BinInt.
 Require Import Setoid.
 Require Export Ncring.
 Require Export Ncring_polynom.
-Import List.
 
 Set Implicit Arguments.
 
@@ -78,7 +77,8 @@ Context {R:Type}`{Ring R}.
   | Z0 => 0
   | Zneg p => -(gen_phiPOS p)
   end.
- Notation "[ x ]" := (gen_phiZ x).
+ Local Notation "[ x ]" := (gen_phiZ x) : ZMORPHISM.
+ Local Open Scope ZMORPHISM.
 
  Definition get_signZ z :=
   match z with
diff --git a/plugins/setoid_ring/Ring_polynom.v b/plugins/setoid_ring/Ring_polynom.v
index 760ad4da1..b69196679 100644
--- a/plugins/setoid_ring/Ring_polynom.v
+++ b/plugins/setoid_ring/Ring_polynom.v
@@ -883,7 +883,7 @@ Section MakeRingPol.
  revert P1. induction LM1 as [|(M2,P2') LM2 IH]; simpl; intros.
  - discriminate.
  - assert (H':=PNSubst_ok n P3 M2 P2'). destruct PNSubst.
-   * injection H; intros <-. rewrite <- PSubstL1_ok; intuition.
+   * injection H as <-. rewrite <- PSubstL1_ok; intuition.
    * now apply IH.
  Qed.
 
diff --git a/plugins/setoid_ring/Ring_tac.v b/plugins/setoid_ring/Ring_tac.v
index 77863edc1..fc02cef10 100644
--- a/plugins/setoid_ring/Ring_tac.v
+++ b/plugins/setoid_ring/Ring_tac.v
@@ -422,8 +422,6 @@ Tactic Notation (at level 0)
   let G := Get_goal in
   ring_lookup (PackRing Ring_simplify) [lH] rl G.
 
-(* MON DIEU QUE C'EST MOCHE !!!!!!!!!!!!! *)
-
 Tactic Notation "ring_simplify" constr_list(rl) "in" hyp(H):=
   let G := Get_goal in
   let t := type of H in
diff --git a/plugins/setoid_ring/Ring_theory.v b/plugins/setoid_ring/Ring_theory.v
index 7fcd6c08a..f7757a18d 100644
--- a/plugins/setoid_ring/Ring_theory.v
+++ b/plugins/setoid_ring/Ring_theory.v
@@ -238,7 +238,6 @@ Section ALMOST_RING.
  Variable req : R -> R -> Prop.
  Notation "0" := rO.  Notation "1" := rI.
  Infix "==" := req. Infix "+" := radd.  Infix "* " := rmul.
- Infix "-" := rsub. Notation "- x" := (ropp x).
 
  (** Leibniz equality leads to a setoid theory and is extensional*)
  Lemma Eqsth : Equivalence (@eq R).
@@ -263,7 +262,7 @@ Section ALMOST_RING.
         -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).
+ Definition SRsub x y := x + -y. Infix "-" := SRsub.
 
  Lemma SRopp_ext : forall x y, x == y -> -x == -y.
  Proof. intros x y H; exact H. Qed.
@@ -320,6 +319,8 @@ Section ALMOST_RING.
  Qed.
 
  End  SEMI_RING.
+ Infix "-" := rsub.
+ Notation "- x" := (ropp x).
 
  Variable Reqe : ring_eq_ext radd rmul ropp req.
    Add Morphism radd : radd_ext2.  exact (Radd_ext Reqe). Qed.
diff --git a/plugins/setoid_ring/g_newring.ml4 b/plugins/setoid_ring/g_newring.ml4
index f64226e33..0987c44ae 100644
--- a/plugins/setoid_ring/g_newring.ml4
+++ b/plugins/setoid_ring/g_newring.ml4
@@ -15,25 +15,43 @@ open Printer
 open Newring_ast
 open Newring
 open Stdarg
-open Constrarg
+open Tacarg
 open Pcoq.Constr
-open Pcoq.Tactic
+open Pltac
 
 DECLARE PLUGIN "newring_plugin"
 
 TACTIC EXTEND protect_fv
   [ "protect_fv" string(map) "in" ident(id) ] ->
-    [ Proofview.V82.tactic (protect_tac_in map id) ]
+    [ protect_tac_in map id ]
 | [ "protect_fv" string(map) ] ->
-    [ Proofview.V82.tactic (protect_tac map) ]
+    [ protect_tac map ]
 END
 
 TACTIC EXTEND closed_term
   [ "closed_term" constr(t) "[" ne_reference_list(l) "]" ] ->
-    [ Proofview.V82.tactic (closed_term t l) ]
+    [ closed_term t l ]
 END
 
+open Pptactic
+open Ppconstr
+
+let pr_ring_mod = function
+  | Ring_kind (Computational eq_test) -> str "decidable" ++ pr_arg pr_constr_expr eq_test
+  | Ring_kind Abstract ->  str "abstract"
+  | Ring_kind (Morphism morph) -> str "morphism" ++ pr_arg pr_constr_expr morph
+  | Const_tac (CstTac cst_tac) -> str "constants" ++ spc () ++ str "[" ++ pr_raw_tactic cst_tac ++ str "]"
+  | Const_tac (Closed l) -> str "closed" ++ spc () ++ str "[" ++ prlist_with_sep spc pr_reference l ++ str "]"
+  | Pre_tac t -> str "preprocess" ++ spc () ++ str "[" ++ pr_raw_tactic t ++ str "]"
+  | Post_tac t -> str "postprocess" ++ spc () ++ str "[" ++ pr_raw_tactic t ++ str "]"
+  | Setoid(sth,ext) -> str "setoid" ++ pr_arg pr_constr_expr sth ++ pr_arg pr_constr_expr ext
+  | Pow_spec(Closed l,spec) -> str "power_tac" ++ pr_arg pr_constr_expr spec ++ spc () ++ str "[" ++ prlist_with_sep spc pr_reference l ++ str "]"
+  | Pow_spec(CstTac cst_tac,spec) -> str "power_tac" ++ pr_arg pr_constr_expr spec ++ spc () ++ str "[" ++ pr_raw_tactic cst_tac ++ str "]"
+  | Sign_spec t -> str "sign" ++ pr_arg pr_constr_expr t
+  | Div_spec t -> str "div" ++ pr_arg pr_constr_expr t
+
 VERNAC ARGUMENT EXTEND ring_mod
+  PRINTED BY pr_ring_mod
   | [ "decidable" constr(eq_test) ] -> [ Ring_kind(Computational eq_test) ]
   | [ "abstract" ] -> [ Ring_kind Abstract ]
   | [ "morphism" constr(morph) ] -> [ Ring_kind(Morphism morph) ]
@@ -50,7 +68,10 @@ VERNAC ARGUMENT EXTEND ring_mod
   | [ "div" constr(div_spec) ] -> [ Div_spec div_spec ]
 END
 
+let pr_ring_mods l = surround (prlist_with_sep pr_comma pr_ring_mod l)
+
 VERNAC ARGUMENT EXTEND ring_mods
+  PRINTED BY pr_ring_mods
   | [ "(" ne_ring_mod_list_sep(mods, ",") ")" ] -> [ mods ]
 END
 
@@ -74,12 +95,20 @@ TACTIC EXTEND ring_lookup
     [ let (t,lr) = List.sep_last lrt in ring_lookup f lH lr t]
 END
 
+let pr_field_mod = function
+  | Ring_mod m -> pr_ring_mod m
+  | Inject inj -> str "completeness" ++ pr_arg pr_constr_expr inj
+
 VERNAC ARGUMENT EXTEND field_mod
+  PRINTED BY pr_field_mod
   | [ ring_mod(m) ] -> [ Ring_mod m ]
   | [ "completeness" constr(inj) ] -> [ Inject inj ]
 END
 
+let pr_field_mods l = surround (prlist_with_sep pr_comma pr_field_mod l)
+
 VERNAC ARGUMENT EXTEND field_mods
+  PRINTED BY pr_field_mods
   | [ "(" ne_field_mod_list_sep(mods, ",") ")" ] -> [ mods ]
 END
 
diff --git a/plugins/setoid_ring/newring.ml b/plugins/setoid_ring/newring.ml
index 154ec6e1b..657efe175 100644
--- a/plugins/setoid_ring/newring.ml
+++ b/plugins/setoid_ring/newring.ml
@@ -7,12 +7,12 @@
 (************************************************************************)
 
 open Pp
-open Errors
+open CErrors
 open Util
 open Names
 open Term
 open Vars
-open Closure
+open CClosure
 open Environ
 open Libnames
 open Globnames
@@ -34,15 +34,6 @@ open Proofview.Notations
 (****************************************************************************)
 (* controlled reduction *)
 
-(** ppedrot: something dubious here, we're obviously using evars the wrong
-    way. FIXME! *)
-
-let mark_arg i c = mkEvar(Evar.unsafe_of_int i,[|c|])
-let unmark_arg f c =
-  match destEvar c with
-    | (i,[|c|]) -> f (Evar.repr i) c
-    | _ -> assert false
-
 type protect_flag = Eval|Prot|Rec
 
 let tag_arg tag_rec map subs i c =
@@ -75,12 +66,10 @@ and mk_clos_app_but f_map subs f args n =
     let fargs, args' = Array.chop n args in
     let f' = mkApp(f,fargs) in
     match f_map (global_of_constr_nofail f') with
-        Some map ->
-          mk_clos_deep
-            (fun s' -> unmark_arg (tag_arg (mk_clos_but f_map s') map s'))
-            subs
-            (mkApp (mark_arg (-1) f', Array.mapi mark_arg args'))
-      | None -> mk_clos_app_but f_map subs f args (n+1)
+    | Some map ->
+       let f i t = tag_arg (mk_clos_but f_map subs) map subs i t in
+       mk_red (FApp (f (-1) f', Array.mapi f args'))
+    | None -> mk_atom (mkApp (f, args))
 
 let interp_map l t =
   try Some(List.assoc_f eq_gr t l) with Not_found -> None
@@ -90,26 +79,26 @@ let add_map s m = protect_maps := String.Map.add s m !protect_maps
 let lookup_map map =
   try String.Map.find map !protect_maps
   with Not_found ->
-    errorlabstrm"lookup_map"(str"map "++qs map++str"not found")
+    user_err ~hdr:"lookup_map" (str"map "++qs map++str"not found")
 
 let protect_red map env sigma c =
-  kl (create_clos_infos betadeltaiota env)
+  kl (create_clos_infos all env)
     (mk_clos_but (lookup_map map c) (Esubst.subs_id 0) c);;
 
 let protect_tac map =
-  Proofview.V82.of_tactic (Tactics.reduct_option (protect_red map,DEFAULTcast) None);;
+  Tactics.reduct_option (protect_red map,DEFAULTcast) None
 
 let protect_tac_in map id =
-  Proofview.V82.of_tactic (Tactics.reduct_option (protect_red map,DEFAULTcast) (Some(id, Locus.InHyp)));;
+  Tactics.reduct_option (protect_red map,DEFAULTcast) (Some(id, Locus.InHyp))
 
 
 (****************************************************************************)
 
 let closed_term t l =
+  let open Quote_plugin in
   let l = List.map Universes.constr_of_global l in
   let cs = List.fold_right Quote.ConstrSet.add l Quote.ConstrSet.empty in
-  if Quote.closed_under cs t then tclIDTAC else tclFAIL 0 (mt())
-;;
+  if Quote.closed_under cs t then Proofview.tclUNIT () else Tacticals.New.tclFAIL 0 (mt())
 
 (* TACTIC EXTEND echo
 | [ "echo" constr(t) ] ->
@@ -135,8 +124,8 @@ let closed_term_ast l =
   let l = List.map (fun gr -> ArgArg(Loc.ghost,gr)) l in
   TacFun([Some(Id.of_string"t")],
   TacML(Loc.ghost,tacname,
-  [TacGeneric (Genarg.in_gen (Genarg.glbwit Constrarg.wit_constr) (GVar(Loc.ghost,Id.of_string"t"),None));
-   TacGeneric (Genarg.in_gen (Genarg.glbwit (Genarg.wit_list Constrarg.wit_ref)) l)]))
+  [TacGeneric (Genarg.in_gen (Genarg.glbwit Stdarg.wit_constr) (GVar(Loc.ghost,Id.of_string"t"),None));
+   TacGeneric (Genarg.in_gen (Genarg.glbwit (Genarg.wit_list Stdarg.wit_ref)) l)]))
 (*
 let _ = add_tacdef false ((Loc.ghost,Id.of_string"ring_closed_term"
 *)
@@ -359,13 +348,13 @@ let find_ring_structure env sigma l =
         let check c =
           let ty' = Retyping.get_type_of env sigma c in
           if not (Reductionops.is_conv env sigma ty ty') then
-            errorlabstrm "ring"
+            user_err ~hdr:"ring"
               (str"arguments of ring_simplify do not have all the same type")
         in
         List.iter check cl';
         (try ring_for_carrier ty
         with Not_found ->
-          errorlabstrm "ring"
+          user_err ~hdr:"ring"
             (str"cannot find a declared ring structure over"++
              spc()++str"\""++pr_constr ty++str"\""))
     | [] -> assert false
@@ -839,13 +828,13 @@ let find_field_structure env sigma l =
         let check c =
           let ty' = Retyping.get_type_of env sigma c in
           if not (Reductionops.is_conv env sigma ty ty') then
-            errorlabstrm "field"
+            user_err ~hdr:"field"
               (str"arguments of field_simplify do not have all the same type")
         in
         List.iter check cl';
         (try field_for_carrier ty
         with Not_found ->
-          errorlabstrm "field"
+          user_err ~hdr:"field"
             (str"cannot find a declared field structure over"++
              spc()++str"\""++pr_constr ty++str"\""))
     | [] -> assert false
diff --git a/plugins/setoid_ring/newring.mli b/plugins/setoid_ring/newring.mli
index ca6aba9a0..f417c87cd 100644
--- a/plugins/setoid_ring/newring.mli
+++ b/plugins/setoid_ring/newring.mli
@@ -15,11 +15,11 @@ open Tacexpr
 open Proof_type
 open Newring_ast
 
-val protect_tac_in : string -> Id.t -> tactic
+val protect_tac_in : string -> Id.t -> unit Proofview.tactic
 
-val protect_tac : string -> tactic
+val protect_tac : string -> unit Proofview.tactic
 
-val closed_term : constr -> global_reference list -> tactic
+val closed_term : constr -> global_reference list -> unit Proofview.tactic
 
 val process_ring_mods :
   constr_expr ring_mod list ->
diff --git a/plugins/setoid_ring/newring_plugin.mllib b/plugins/setoid_ring/newring_plugin.mllib
deleted file mode 100644
index 7d6c49588..000000000
--- a/plugins/setoid_ring/newring_plugin.mllib
+++ /dev/null
@@ -1,3 +0,0 @@
-Newring
-Newring_plugin_mod
-G_newring
diff --git a/plugins/setoid_ring/newring_plugin.mlpack b/plugins/setoid_ring/newring_plugin.mlpack
new file mode 100644
index 000000000..23663b409
--- /dev/null
+++ b/plugins/setoid_ring/newring_plugin.mlpack
@@ -0,0 +1,2 @@
+Newring
+G_newring
diff --git a/plugins/ssrmatching/ssrmatching.ml4 b/plugins/ssrmatching/ssrmatching.ml4
new file mode 100644
index 000000000..fc988a2c5
--- /dev/null
+++ b/plugins/ssrmatching/ssrmatching.ml4
@@ -0,0 +1,1448 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+(* This file is (C) Copyright 2006-2015 Microsoft Corporation and Inria. *)
+
+(* Defining grammar rules with "xx" in it automatically declares keywords too,
+ * we thus save the lexer to restore it at the end of the file *)
+let frozen_lexer = CLexer.freeze () ;;
+
+(*i camlp4use: "pa_extend.cmo" i*)
+(*i camlp4deps: "grammar/grammar.cma" i*)
+
+open Names
+open Pp
+open Pcoq
+open Genarg
+open Stdarg
+open Tacarg
+open Term
+open Vars
+open Topconstr
+open Libnames
+open Tactics
+open Tacticals
+open Termops
+open Namegen
+open Recordops
+open Tacmach
+open Coqlib
+open Glob_term
+open Util
+open Evd
+open Extend
+open Goptions
+open Tacexpr
+open Proofview.Notations
+open Tacinterp
+open Pretyping
+open Constr
+open Pltac
+open Extraargs
+open Ppconstr
+open Printer
+
+open Globnames
+open Misctypes
+open Decl_kinds
+open Evar_kinds
+open Constrexpr
+open Constrexpr_ops
+open Notation_term
+open Notation_ops
+open Locus
+open Locusops
+
+DECLARE PLUGIN "ssrmatching_plugin"
+
+type loc = Loc.t
+let dummy_loc = Loc.ghost
+let errorstrm = CErrors.user_err ~hdr:"ssrmatching"
+let loc_error loc msg = CErrors.user_err ~loc ~hdr:msg (str msg)
+let ppnl = Feedback.msg_info
+
+(* 0 cost pp function. Active only if env variable SSRDEBUG is set *)
+(* or if SsrDebug is Set                                                  *)
+let pp_ref = ref (fun _ -> ())
+let ssr_pp s = Feedback.msg_debug (str"SSR: "++Lazy.force s)
+let _ =
+  try ignore(Sys.getenv "SSRMATCHINGDEBUG"); pp_ref := ssr_pp
+  with Not_found -> ()
+let debug b =
+  if b then pp_ref := ssr_pp else pp_ref := fun _ -> ()
+let _ =
+  Goptions.declare_bool_option
+    { Goptions.optsync  = false;
+      Goptions.optname  = "ssrmatching debugging";
+      Goptions.optkey   = ["Debug";"SsrMatching"];
+      Goptions.optdepr  = false;
+      Goptions.optread  = (fun _ -> !pp_ref == ssr_pp);
+      Goptions.optwrite = debug }
+let pp s = !pp_ref s
+
+(** Utils {{{ *****************************************************************)
+let env_size env = List.length (Environ.named_context env)
+let safeDestApp c =
+  match kind_of_term c with App (f, a) -> f, a | _ -> c, [| |]
+let get_index = function ArgArg i -> i | _ ->
+  CErrors.anomaly (str"Uninterpreted index")
+(* Toplevel constr must be globalized twice ! *)
+let glob_constr ist genv = function
+  | _, Some ce ->
+    let vars = Id.Map.fold (fun x _ accu -> Id.Set.add x accu) ist.lfun Id.Set.empty in
+    let ltacvars = { Constrintern.empty_ltac_sign with Constrintern.ltac_vars = vars } in
+    Constrintern.intern_gen WithoutTypeConstraint ~ltacvars:ltacvars genv ce
+  | rc, None -> rc
+
+(* Term printing utilities functions for deciding bracketing.  *)
+let pr_paren prx x = hov 1 (str "(" ++ prx x ++ str ")")
+(* String lexing utilities *)
+let skip_wschars s =
+  let rec loop i = match s.[i] with '\n'..' ' -> loop (i + 1) | _ -> i in loop
+(* We also guard characters that might interfere with the ssreflect   *)
+(* tactic syntax.                                                     *)
+let guard_term ch1 s i = match s.[i] with
+  | '(' -> false
+  | '{' | '/' | '=' -> true
+  | _ -> ch1 = '('
+(* The call 'guard s i' should return true if the contents of s *)
+(* starting at i need bracketing to avoid ambiguities.          *)
+let pr_guarded guard prc c =
+  let s = Pp.string_of_ppcmds (prc c) ^ "$" in
+  if guard s (skip_wschars s 0) then pr_paren prc c else prc c
+(* More sensible names for constr printers *)
+let pr_constr = pr_constr
+let prl_glob_constr c = pr_lglob_constr_env (Global.env ()) c
+let pr_glob_constr c = pr_glob_constr_env (Global.env ()) c
+let prl_constr_expr = pr_lconstr_expr
+let pr_constr_expr = pr_constr_expr
+let prl_glob_constr_and_expr = function
+  | _, Some c -> prl_constr_expr c
+  | c, None -> prl_glob_constr c
+let pr_glob_constr_and_expr = function
+  | _, Some c -> pr_constr_expr c
+  | c, None -> pr_glob_constr c
+let pr_term (k, c) = pr_guarded (guard_term k) pr_glob_constr_and_expr c
+let prl_term (k, c) = pr_guarded (guard_term k) prl_glob_constr_and_expr c
+
+(** Adding a new uninterpreted generic argument type *)
+let add_genarg tag pr =
+  let wit = Genarg.make0 tag in
+  let tag = Geninterp.Val.create tag in
+  let glob ist x = (ist, x) in
+  let subst _ x = x in
+  let interp ist x = Ftactic.return (Geninterp.Val.Dyn (tag, x)) in
+  let gen_pr _ _ _ = pr in
+  let () = Genintern.register_intern0 wit glob in
+  let () = Genintern.register_subst0 wit subst in
+  let () = Geninterp.register_interp0 wit interp in
+  let () = Geninterp.register_val0 wit (Some (Geninterp.Val.Base tag)) in
+  Pptactic.declare_extra_genarg_pprule wit gen_pr gen_pr gen_pr;
+  wit
+
+(** Constructors for cast type *)
+let dC t = CastConv t
+(** Constructors for constr_expr *)
+let isCVar = function CRef (Ident _, _) -> true | _ -> false
+let destCVar = function CRef (Ident (_, id), _) -> id | _ ->
+  CErrors.anomaly (str"not a CRef")
+let mkCHole loc = CHole (loc, None, IntroAnonymous, None)
+let mkCLambda loc name ty t = 
+   CLambdaN (loc, [[loc, name], Default Explicit, ty], t)
+let mkCLetIn loc name bo t = 
+   CLetIn (loc, (loc, name), bo, t)
+let mkCCast loc t ty = CCast (loc,t, dC ty)
+(** Constructors for rawconstr *)
+let mkRHole = GHole (dummy_loc, InternalHole, IntroAnonymous, None)
+let mkRApp f args = if args = [] then f else GApp (dummy_loc, f, args)
+let mkRCast rc rt =  GCast (dummy_loc, rc, dC rt)
+let mkRLambda n s t = GLambda (dummy_loc, n, Explicit, s, t)
+
+(* ssrterm conbinators *)
+let combineCG t1 t2 f g = match t1, t2 with
+ | (x, (t1, None)), (_, (t2, None)) -> x, (g t1 t2, None)
+ | (x, (_, Some t1)), (_, (_, Some t2)) -> x, (mkRHole, Some (f t1 t2))
+ | _, (_, (_, None)) -> CErrors.anomaly (str"have: mixed C-G constr")
+ | _ -> CErrors.anomaly (str"have: mixed G-C constr")
+let loc_ofCG = function
+ | (_, (s, None)) -> Glob_ops.loc_of_glob_constr s
+ | (_, (_, Some s)) -> Constrexpr_ops.constr_loc s
+
+let mk_term k c = k, (mkRHole, Some c)
+let mk_lterm = mk_term ' '
+
+let pf_type_of gl t = let sigma, ty = pf_type_of gl t in re_sig (sig_it gl)  sigma, ty
+
+(* }}} *)
+
+(** Profiling {{{ *************************************************************)
+type profiler = { 
+  profile : 'a 'b. ('a -> 'b) -> 'a -> 'b;
+  reset : unit -> unit;
+  print : unit -> unit }
+let profile_now = ref false
+let something_profiled = ref false
+let profilers = ref []
+let add_profiler f = profilers := f :: !profilers;;
+let profile b =
+  profile_now := b;
+  if b then List.iter (fun f -> f.reset ()) !profilers;
+  if not b then List.iter (fun f -> f.print ()) !profilers
+;;
+let _ =
+  Goptions.declare_bool_option
+    { Goptions.optsync  = false;
+      Goptions.optname  = "ssrmatching profiling";
+      Goptions.optkey   = ["SsrMatchingProfiling"];
+      Goptions.optread  = (fun _ -> !profile_now);
+      Goptions.optdepr  = false;
+      Goptions.optwrite = profile }
+let () =
+  let prof_total = 
+    let init = ref 0.0 in { 
+    profile = (fun f x -> assert false);
+    reset = (fun () -> init := Unix.gettimeofday ());
+    print = (fun () -> if !something_profiled then
+        prerr_endline 
+           (Printf.sprintf "!! %-39s %10d %9.4f %9.4f %9.4f"
+           "total" 0 (Unix.gettimeofday() -. !init) 0.0 0.0)) } in
+  let prof_legenda = {
+    profile = (fun f x -> assert false);
+    reset = (fun () -> ());
+    print = (fun () -> if !something_profiled then begin
+        prerr_endline 
+           (Printf.sprintf "!! %39s ---------- --------- --------- ---------" 
+           (String.make 39 '-'));
+        prerr_endline 
+           (Printf.sprintf "!! %-39s %10s %9s %9s %9s" 
+           "function" "#calls" "total" "max" "average") end) } in
+  add_profiler prof_legenda;
+  add_profiler prof_total
+;;
+
+let mk_profiler s =
+  let total, calls, max = ref 0.0, ref 0, ref 0.0 in
+  let reset () = total := 0.0; calls := 0; max := 0.0 in
+  let profile f x =
+    if not !profile_now then f x else
+    let before = Unix.gettimeofday () in
+    try
+      incr calls;
+      let res = f x in
+      let after = Unix.gettimeofday () in
+      let delta = after -. before in
+      total := !total +. delta;
+      if delta > !max then max := delta;
+      res
+    with exc ->
+      let after = Unix.gettimeofday () in
+      let delta = after -. before in
+      total := !total +. delta;
+      if delta > !max then max := delta;
+      raise exc in
+  let print () =
+     if !calls <> 0 then begin
+       something_profiled := true;
+       prerr_endline
+         (Printf.sprintf "!! %-39s %10d %9.4f %9.4f %9.4f" 
+         s !calls !total !max (!total /. (float_of_int !calls))) end in
+  let prof = { profile = profile; reset = reset; print = print } in
+  add_profiler prof;
+  prof
+;;
+(* }}} *)
+
+exception NoProgress
+
+(** Unification procedures.                                *)
+
+(* To enforce the rigidity of the rooted match we always split  *)
+(* top applications, so the unification procedures operate on   *)
+(* arrays of patterns and terms.                                *)
+(* We perform three kinds of unification:                       *)
+(*  EQ: exact conversion check                                  *)
+(*  FO: first-order unification of evars, without conversion    *)
+(*  HO: higher-order unification with conversion                *)
+(* The subterm unification strategy is to find the first FO     *)
+(* match, if possible, and the first HO match otherwise, then   *)
+(* compute all the occurrences that are EQ matches for the      *)
+(* relevant subterm.                                            *)
+(*   Additional twists:                                         *)
+(*    - If FO/HO fails then we attempt to fill evars using      *)
+(*      typeclasses before raising an outright error. We also   *)
+(*      fill typeclasses even after a successful match, since   *)
+(*      beta-reduction and canonical instances may leave        *)
+(*      undefined evars.                                        *)
+(*    - We do postchecks to rule out matches that are not       *)
+(*      closed or that assign to a global evar; these can be    *)
+(*      disabled for rewrite or dependent family matches.       *)
+(*    - We do a full FO scan before turning to HO, as the FO    *)
+(*      comparison can be much faster than the HO one.          *)
+
+let unif_EQ env sigma p c =
+  let evars = existential_opt_value sigma, Evd.universes sigma in 
+  try let _ = Reduction.conv env p ~evars c in true with _ -> false
+
+let unif_EQ_args env sigma pa a =
+  let n = Array.length pa in
+  let rec loop i = (i = n) || unif_EQ env sigma pa.(i) a.(i) && loop (i + 1) in
+  loop 0
+
+let prof_unif_eq_args = mk_profiler "unif_EQ_args";;
+let unif_EQ_args env sigma pa a =
+  prof_unif_eq_args.profile (unif_EQ_args env sigma pa) a 
+;;
+
+let unif_HO env ise p c = Evarconv.the_conv_x env p c ise
+
+let unif_HOtype env ise p c = Evarconv.the_conv_x_leq env p c ise
+
+let unif_HO_args env ise0 pa i ca =
+  let n = Array.length pa in
+  let rec loop ise j =
+    if j = n then ise else loop (unif_HO env ise pa.(j) ca.(i + j)) (j + 1) in
+  loop ise0 0
+
+(* FO unification should boil down to calling w_unify with no_delta, but  *)
+(* alas things are not so simple: w_unify does partial type-checking,     *)
+(* which breaks down when the no-delta flag is on (as the Coq type system *)
+(* requires full convertibility. The workaround here is to convert all    *)
+(* evars into metas, since 8.2 does not TC metas. This means some lossage *)
+(* for HO evars, though hopefully Miller patterns can pick up some of     *)
+(* those cases, and HO matching will mop up the rest.                     *)
+let flags_FO =
+  let flags =
+    { (Unification.default_no_delta_unify_flags ()).Unification.core_unify_flags
+      with
+        Unification.modulo_conv_on_closed_terms = None;
+        Unification.modulo_eta = true;
+        Unification.modulo_betaiota = true;
+        Unification.modulo_delta_types = full_transparent_state}
+  in
+  { Unification.core_unify_flags = flags;
+    Unification.merge_unify_flags = flags;
+    Unification.subterm_unify_flags = flags;
+    Unification.allow_K_in_toplevel_higher_order_unification = false;
+    Unification.resolve_evars =
+      (Unification.default_no_delta_unify_flags ()).Unification.resolve_evars
+  }
+let unif_FO env ise p c =
+  Unification.w_unify env ise Reduction.CONV ~flags:flags_FO p c
+
+(* Perform evar substitution in main term and prune substitution. *)
+let nf_open_term sigma0 ise c =
+  let s = ise and s' = ref sigma0 in
+  let rec nf c' = match kind_of_term c' with
+  | Evar ex ->
+    begin try nf (existential_value s ex) with _ ->
+    let k, a = ex in let a' = Array.map nf a in
+    if not (Evd.mem !s' k) then
+      s' := Evd.add !s' k (Evarutil.nf_evar_info s (Evd.find s k));
+    mkEvar (k, a')
+    end
+  | _ -> map_constr nf c' in
+  let copy_def k evi () =
+    if evar_body evi != Evd.Evar_empty then () else
+    match Evd.evar_body (Evd.find s k) with
+    | Evar_defined c' -> s' := Evd.define k (nf c') !s'
+    | _ -> () in
+  let c' = nf c in let _ = Evd.fold copy_def sigma0 () in
+  !s', Evd.evar_universe_context s, c'
+
+let unif_end env sigma0 ise0 pt ok =
+  let ise = Evarconv.solve_unif_constraints_with_heuristics env ise0 in
+  let s, uc, t = nf_open_term sigma0 ise pt in
+  let ise1 = create_evar_defs s in
+  let ise1 = Evd.set_universe_context ise1 uc in
+  let ise2 = Typeclasses.resolve_typeclasses ~fail:true env ise1 in
+  if not (ok ise) then raise NoProgress else
+  if ise2 == ise1 then (s, uc, t)
+  else
+    let s, uc', t = nf_open_term sigma0 ise2 t in
+    s, Evd.union_evar_universe_context uc uc', t
+
+let pf_unif_HO gl sigma pt p c =
+  let env = pf_env gl in
+  let ise = unif_HO env (create_evar_defs sigma) p c in
+  unif_end env (project gl) ise pt (fun _ -> true)
+
+let unify_HO env sigma0 t1 t2 =
+  let sigma = unif_HO env sigma0 t1 t2 in
+  let sigma, uc, _ = unif_end env sigma0 sigma t2 (fun _ -> true) in
+  Evd.set_universe_context sigma uc
+
+let pf_unify_HO gl t1 t2 =
+  let env, sigma0, si = pf_env gl, project gl, sig_it gl in
+  let sigma = unify_HO env sigma0 t1 t2 in
+  re_sig si sigma
+
+(* This is what the definition of iter_constr should be... *)
+let iter_constr_LR f c = match kind_of_term c with
+  | Evar (k, a) -> Array.iter f a
+  | Cast (cc, _, t) -> f cc; f t  
+  | Prod (_, t, b) | Lambda (_, t, b)  -> f t; f b
+  | LetIn (_, v, t, b) -> f v; f t; f b
+  | App (cf, a) -> f cf; Array.iter f a
+  | Case (_, p, v, b) -> f v; f p; Array.iter f b
+  | Fix (_, (_, t, b)) | CoFix (_, (_, t, b)) ->
+    for i = 0 to Array.length t - 1 do f t.(i); f b.(i) done
+  | Proj(_,a) -> f a
+  | (Rel _ | Meta _ | Var _   | Sort _ | Const _ | Ind _ | Construct _) -> ()
+
+(* The comparison used to determine which subterms matches is KEYED        *)
+(* CONVERSION. This looks for convertible terms that either have the same  *)
+(* same head constant as pat if pat is an application (after beta-iota),   *)
+(* or start with the same constr constructor (esp. for LetIn); this is     *)
+(* disregarded if the head term is let x := ... in x, and casts are always *)
+(* ignored and removed).                                                   *)
+(* Record projections get special treatment: in addition to the projection *)
+(* constant itself, ssreflect also recognizes head constants of canonical  *)
+(* projections.                                                            *)
+
+exception NoMatch
+type ssrdir = L2R | R2L
+let pr_dir_side = function L2R -> str "LHS" | R2L -> str "RHS"
+let inv_dir = function L2R -> R2L | R2L -> L2R
+
+
+type pattern_class =
+  | KpatFixed
+  | KpatConst
+  | KpatEvar of existential_key
+  | KpatLet
+  | KpatLam
+  | KpatRigid
+  | KpatFlex
+  | KpatProj of constant
+
+type tpattern = {
+  up_k : pattern_class;
+  up_FO : constr;
+  up_f : constr;
+  up_a : constr array;
+  up_t : constr;                      (* equation proof term or matched term *)
+  up_dir : ssrdir;                    (* direction of the rule *)
+  up_ok : constr -> evar_map -> bool; (* progess test for rewrite *)
+  }
+
+let all_ok _ _ = true
+
+let proj_nparams c =
+  try 1 + Recordops.find_projection_nparams (ConstRef c) with _ -> 0
+
+let isFixed c = match kind_of_term c with
+  | Var _ | Ind _ | Construct _ | Const _ | Proj _ -> true
+  | _ -> false
+
+let isRigid c = match kind_of_term c with
+  | Prod _ | Sort _ | Lambda _ | Case _ | Fix _ | CoFix _ -> true
+  | _ -> false
+
+exception UndefPat
+
+let hole_var = mkVar (id_of_string "_")
+let pr_constr_pat c0 =
+  let rec wipe_evar c =
+    if isEvar c then hole_var else map_constr wipe_evar c in
+  pr_constr (wipe_evar c0)
+
+(* Turn (new) evars into metas *)
+let evars_for_FO ~hack env sigma0 (ise0:evar_map) c0 =
+  let ise = ref ise0 in
+  let sigma = ref ise0 in
+  let nenv = env_size env + if hack then 1 else 0 in
+  let rec put c = match kind_of_term c with
+  | Evar (k, a as ex) ->
+    begin try put (existential_value !sigma ex)
+    with NotInstantiatedEvar ->
+    if Evd.mem sigma0 k then map_constr put c else
+    let evi = Evd.find !sigma k in
+    let dc = List.firstn (max 0 (Array.length a - nenv)) (evar_filtered_context evi) in
+    let abs_dc (d, c) = function
+    | Context.Named.Declaration.LocalDef (x, b, t) ->
+        d, mkNamedLetIn x (put b) (put t) c
+    | Context.Named.Declaration.LocalAssum (x, t) ->
+        mkVar x :: d, mkNamedProd x (put t) c in
+    let a, t =
+      Context.Named.fold_inside abs_dc ~init:([], (put evi.evar_concl)) dc in
+    let m = Evarutil.new_meta () in
+    ise := meta_declare m t !ise;
+    sigma := Evd.define k (applist (mkMeta m, a)) !sigma;
+    put (existential_value !sigma ex)
+    end
+  | _ -> map_constr put c in
+  let c1 = put c0 in !ise, c1
+
+(* Compile a match pattern from a term; t is the term to fill. *)
+(* p_origin can be passed to obtain a better error message     *)
+let mk_tpattern ?p_origin ?(hack=false) env sigma0 (ise, t) ok dir p =
+  let k, f, a =
+    let f, a = Reductionops.whd_betaiota_stack ise p in
+    match kind_of_term f with
+    | Const (p,_) ->
+      let np = proj_nparams p in
+      if np = 0 || np > List.length a then KpatConst, f, a else
+      let a1, a2 = List.chop np a in KpatProj p, applist(f, a1), a2
+    | Proj (p,arg) -> KpatProj (Projection.constant p), f, a
+    | Var _ | Ind _ | Construct _ -> KpatFixed, f, a
+    | Evar (k, _) ->
+      if Evd.mem sigma0 k then KpatEvar k, f, a else
+      if a <> [] then KpatFlex, f, a else 
+      (match p_origin with None -> CErrors.error "indeterminate pattern"
+      | Some (dir, rule) ->
+	errorstrm (str "indeterminate " ++ pr_dir_side dir
+          ++ str " in " ++ pr_constr_pat rule))
+    | LetIn (_, v, _, b) ->
+      if b <> mkRel 1 then KpatLet, f, a else KpatFlex, v, a
+    | Lambda _ -> KpatLam, f, a
+    | _ -> KpatRigid, f, a in
+  let aa = Array.of_list a in
+  let ise', p' = evars_for_FO ~hack env sigma0 ise (mkApp (f, aa)) in
+  ise',
+  { up_k = k; up_FO = p'; up_f = f; 
+    up_a = aa; up_ok = ok; up_dir = dir; up_t = t}
+
+(* Specialize a pattern after a successful match: assign a precise head *)
+(* kind and arity for Proj and Flex patterns.                           *)
+let ungen_upat lhs (sigma, uc, t) u =
+  let f, a = safeDestApp lhs in
+  let k = match kind_of_term f with
+  | Var _ | Ind _ | Construct _ -> KpatFixed
+  | Const _ -> KpatConst
+  | Evar (k, _) -> if is_defined sigma k then raise NoMatch else KpatEvar k
+  | LetIn _ -> KpatLet
+  | Lambda _ -> KpatLam
+  | _ -> KpatRigid in
+  sigma, uc, {u with up_k = k; up_FO = lhs; up_f = f; up_a = a; up_t = t}
+
+let nb_cs_proj_args pc f u =
+  let na k =
+    List.length (snd (lookup_canonical_conversion (ConstRef pc, k))).o_TCOMPS in
+  try match kind_of_term f with
+  | Prod _ -> na Prod_cs
+  | Sort s -> na (Sort_cs (family_of_sort s))
+  | Const (c',_) when Constant.equal c' pc ->
+      begin match kind_of_term u.up_f with
+      | App(_,args) -> Array.length args
+      | Proj _ -> 0 (* if splay_app calls expand_projection, this has to be
+                       the number of arguments including the projected *)
+      | _ -> assert false
+      end
+  | Var _ | Ind _ | Construct _ | Const _ -> na (Const_cs (global_of_constr f))
+  | _ -> -1
+  with Not_found -> -1
+
+let isEvar_k k f =
+  match kind_of_term f with Evar (k', _) -> k = k' | _ -> false
+
+let nb_args c =
+  match kind_of_term c with App (_, a) -> Array.length a | _ -> 0
+
+let mkSubArg i a = if i = Array.length a then a else Array.sub a 0 i
+let mkSubApp f i a = if i = 0 then f else mkApp (f, mkSubArg i a)
+
+let splay_app ise =
+  let rec loop c a = match kind_of_term c with
+  | App (f, a') -> loop f (Array.append a' a)
+  | Cast (c', _, _) -> loop c' a
+  | Evar ex ->
+    (try loop (existential_value ise ex) a with _ -> c, a)
+  | _ -> c, a in
+  fun c -> match kind_of_term c with
+  | App (f, a) -> loop f a
+  | Cast _ | Evar _ -> loop c [| |]
+  | _ -> c, [| |]
+
+let filter_upat i0 f n u fpats =
+  let na = Array.length u.up_a in
+  if n < na then fpats else
+  let np = match u.up_k with
+  | KpatConst when Term.eq_constr u.up_f f -> na
+  | KpatFixed when Term.eq_constr u.up_f f -> na 
+  | KpatEvar k when isEvar_k k f -> na
+  | KpatLet when isLetIn f -> na
+  | KpatLam when isLambda f -> na
+  | KpatRigid when isRigid f -> na
+  | KpatFlex -> na
+  | KpatProj pc ->
+    let np = na + nb_cs_proj_args pc f u in if n < np then -1 else np
+  | _ -> -1 in
+  if np < na then fpats else
+  let () = if !i0 < np then i0 := n in (u, np) :: fpats
+
+let eq_prim_proj c t = match kind_of_term t with
+  | Proj(p,_) -> Constant.equal (Projection.constant p) c
+  | _ -> false
+
+let filter_upat_FO i0 f n u fpats =
+  let np = nb_args u.up_FO in
+  if n < np then fpats else
+  let ok = match u.up_k with
+  | KpatConst -> Term.eq_constr u.up_f f 
+  | KpatFixed -> Term.eq_constr u.up_f f 
+  | KpatEvar k -> isEvar_k k f
+  | KpatLet -> isLetIn f
+  | KpatLam -> isLambda f
+  | KpatRigid -> isRigid f
+  | KpatProj pc -> Term.eq_constr f (mkConst pc) || eq_prim_proj pc f
+  | KpatFlex -> i0 := n; true in
+  if ok then begin if !i0 < np then i0 := np; (u, np) :: fpats end else fpats
+
+exception FoundUnif of (evar_map * evar_universe_context * tpattern)
+(* Note: we don't update env as we descend into the term, as the primitive *)
+(* unification procedure always rejects subterms with bound variables.     *)
+
+let dont_impact_evars_in cl =
+  let evs_in_cl = Evd.evars_of_term cl in
+  fun sigma -> Evar.Set.for_all (fun k ->
+    try let _ = Evd.find_undefined sigma k in true
+    with Not_found -> false) evs_in_cl
+
+(* We are forced to duplicate code between the FO/HO matching because we    *)
+(* have to work around several kludges in unify.ml:                         *)
+(*  - w_unify drops into second-order unification when the pattern is an    *)
+(*    application whose head is a meta.                                     *)
+(*  - w_unify tries to unify types without subsumption when the pattern     *)
+(*    head is an evar or meta (e.g., it fails on ?1 = nat when ?1 : Type).  *)
+(*  - w_unify expands let-in (zeta conversion) eagerly, whereas we want to  *)
+(*    match a head let rigidly.                                             *)
+let match_upats_FO upats env sigma0 ise orig_c =
+  let dont_impact_evars = dont_impact_evars_in orig_c in
+  let rec loop c =
+    let f, a = splay_app ise c in let i0 = ref (-1) in
+    let fpats =
+      List.fold_right (filter_upat_FO i0 f (Array.length a)) upats [] in
+    while !i0 >= 0 do
+      let i = !i0 in i0 := -1;
+      let c' = mkSubApp f i a in
+      let one_match (u, np) =
+         let skip =
+           if i <= np then i < np else
+           if u.up_k == KpatFlex then begin i0 := i - 1; false end else
+           begin if !i0 < np then i0 := np; true end in
+         if skip || not (closed0 c') then () else try
+           let _ = match u.up_k with
+           | KpatFlex ->
+             let kludge v = mkLambda (Anonymous, mkProp, v) in
+             unif_FO env ise (kludge u.up_FO) (kludge c')
+           | KpatLet ->
+             let kludge vla =
+               let vl, a = safeDestApp vla in
+               let x, v, t, b = destLetIn vl in
+               mkApp (mkLambda (x, t, b), Array.cons v a) in
+             unif_FO env ise (kludge u.up_FO) (kludge c')
+           | _ -> unif_FO env ise u.up_FO c' in
+           let ise' = (* Unify again using HO to assign evars *)
+             let p = mkApp (u.up_f, u.up_a) in
+             try unif_HO env ise p c' with _ -> raise NoMatch in
+           let lhs = mkSubApp f i a in
+           let pt' = unif_end env sigma0 ise' u.up_t (u.up_ok lhs) in
+           raise (FoundUnif (ungen_upat lhs pt' u))
+       with FoundUnif (s,_,_) as sig_u when dont_impact_evars s -> raise sig_u
+       | Not_found -> CErrors.anomaly (str"incomplete ise in match_upats_FO")
+       | _ -> () in
+    List.iter one_match fpats
+  done;
+  iter_constr_LR loop f; Array.iter loop a in
+  try loop orig_c with Invalid_argument _ -> CErrors.anomaly (str"IN FO")
+
+let prof_FO = mk_profiler "match_upats_FO";;
+let match_upats_FO upats env sigma0 ise c =
+  prof_FO.profile (match_upats_FO upats env sigma0) ise c
+;;
+
+
+let match_upats_HO ~on_instance upats env sigma0 ise c =
+  let dont_impact_evars = dont_impact_evars_in c in
+ let it_did_match = ref false in
+ let failed_because_of_TC = ref false in
+ let rec aux upats env sigma0 ise c =
+  let f, a = splay_app ise c in let i0 = ref (-1) in
+  let fpats = List.fold_right (filter_upat i0 f (Array.length a)) upats [] in
+  while !i0 >= 0 do
+    let i = !i0 in i0 := -1;
+    let one_match (u, np) =
+      let skip =
+        if i <= np then i < np else
+        if u.up_k == KpatFlex then begin i0 := i - 1; false end else
+        begin if !i0 < np then i0 := np; true end in
+      if skip then () else try
+        let ise' = match u.up_k with
+        | KpatFixed | KpatConst -> ise
+        | KpatEvar _ ->
+          let _, pka = destEvar u.up_f and _, ka = destEvar f in
+          unif_HO_args env ise pka 0 ka
+        | KpatLet ->
+          let x, v, t, b = destLetIn f in
+          let _, pv, _, pb = destLetIn u.up_f in
+          let ise' = unif_HO env ise pv v in
+          unif_HO
+            (Environ.push_rel (Context.Rel.Declaration.LocalAssum(x, t)) env)
+            ise' pb b
+        | KpatFlex | KpatProj _ ->
+          unif_HO env ise u.up_f (mkSubApp f (i - Array.length u.up_a) a)
+        | _ -> unif_HO env ise u.up_f f in
+        let ise'' = unif_HO_args env ise' u.up_a (i - Array.length u.up_a) a in
+        let lhs = mkSubApp f i a in
+        let pt' = unif_end env sigma0 ise'' u.up_t (u.up_ok lhs) in
+        on_instance (ungen_upat lhs pt' u)
+      with FoundUnif (s,_,_) as sig_u when dont_impact_evars s -> raise sig_u
+      | NoProgress -> it_did_match := true
+      | Pretype_errors.PretypeError
+         (_,_,Pretype_errors.UnsatisfiableConstraints _) ->
+          failed_because_of_TC:=true
+      | e when CErrors.noncritical e -> () in
+    List.iter one_match fpats
+  done;
+  iter_constr_LR (aux upats env sigma0 ise) f;
+  Array.iter (aux upats env sigma0 ise) a
+ in
+ aux upats env sigma0 ise c;
+ if !it_did_match then raise NoProgress;
+ !failed_because_of_TC
+
+let prof_HO = mk_profiler "match_upats_HO";;
+let match_upats_HO ~on_instance upats env sigma0 ise c =
+  prof_HO.profile (match_upats_HO ~on_instance upats env sigma0) ise c
+;;
+
+
+let fixed_upat = function
+| {up_k = KpatFlex | KpatEvar _ | KpatProj _} -> false 
+| {up_t = t} -> not (occur_existential t)
+
+let do_once r f = match !r with Some _ -> () | None -> r := Some (f ())
+
+let assert_done r = 
+  match !r with Some x -> x | None -> CErrors.anomaly (str"do_once never called")
+
+let assert_done_multires r = 
+  match !r with
+  | None -> CErrors.anomaly (str"do_once never called")
+  | Some (n, xs) ->
+      r := Some (n+1,xs);
+      try List.nth xs n with Failure _ -> raise NoMatch
+
+type subst = Environ.env -> Term.constr -> Term.constr -> int -> Term.constr
+type find_P = 
+  Environ.env -> Term.constr -> int ->
+  k:subst ->
+     Term.constr
+type conclude = unit ->
+  Term.constr * ssrdir * (Evd.evar_map * Evd.evar_universe_context * Term.constr)
+
+(* upats_origin makes a better error message only            *)
+let mk_tpattern_matcher ?(all_instances=false)
+  ?(raise_NoMatch=false) ?upats_origin sigma0 occ (ise, upats)
+=
+  let nocc = ref 0 and skip_occ = ref false in
+  let use_occ, occ_list = match occ with
+  | Some (true, ol) -> ol = [], ol
+  | Some (false, ol) -> ol <> [], ol
+  | None -> false, [] in
+  let max_occ = List.fold_right max occ_list 0 in
+  let subst_occ =
+    let occ_set = Array.make max_occ (not use_occ) in
+    let _ = List.iter (fun i -> occ_set.(i - 1) <- use_occ) occ_list in
+    let _ = if max_occ = 0 then skip_occ := use_occ in
+    fun () -> incr nocc;
+    if !nocc = max_occ then skip_occ := use_occ;
+    if !nocc <= max_occ then occ_set.(!nocc - 1) else not use_occ in
+  let upat_that_matched = ref None in
+  let match_EQ env sigma u = 
+    match u.up_k with
+    | KpatLet ->
+      let x, pv, t, pb = destLetIn u.up_f in
+      let env' =
+        Environ.push_rel (Context.Rel.Declaration.LocalAssum(x, t)) env in
+      let match_let f = match kind_of_term f with
+      | LetIn (_, v, _, b) -> unif_EQ env sigma pv v && unif_EQ env' sigma pb b
+      | _ -> false in match_let
+    | KpatFixed -> Term.eq_constr u.up_f
+    | KpatConst -> Term.eq_constr u.up_f
+    | KpatLam -> fun c ->
+       (match kind_of_term c with
+       | Lambda _ -> unif_EQ env sigma u.up_f c
+       | _ -> false)
+    | _ -> unif_EQ env sigma u.up_f in
+let p2t p = mkApp(p.up_f,p.up_a) in 
+let source () = match upats_origin, upats with
+  | None, [p] -> 
+      (if fixed_upat p then str"term " else str"partial term ") ++ 
+      pr_constr_pat (p2t p) ++ spc()
+  | Some (dir,rule), [p] -> str"The " ++ pr_dir_side dir ++ str" of " ++ 
+      pr_constr_pat rule ++ fnl() ++ ws 4 ++ pr_constr_pat (p2t p) ++ fnl()
+  | Some (dir,rule), _ -> str"The " ++ pr_dir_side dir ++ str" of " ++ 
+      pr_constr_pat rule ++ spc()
+  | _, [] | None, _::_::_ ->
+      CErrors.anomaly (str"mk_tpattern_matcher with no upats_origin") in
+let on_instance, instances =
+  let instances = ref [] in
+  (fun x ->
+    if all_instances then instances := !instances @ [x]
+    else raise (FoundUnif x)),
+  (fun () -> !instances) in
+let rec uniquize = function
+  | [] -> []
+  | (sigma,_,{ up_f = f; up_a = a; up_t = t } as x) :: xs ->
+    let t = Reductionops.nf_evar sigma t in
+    let f = Reductionops.nf_evar sigma f in
+    let a = Array.map (Reductionops.nf_evar sigma) a in
+    let neq (sigma1,_,{ up_f = f1; up_a = a1; up_t = t1 }) =
+      let t1 = Reductionops.nf_evar sigma1 t1 in
+      let f1 = Reductionops.nf_evar sigma1 f1 in
+      let a1 = Array.map (Reductionops.nf_evar sigma1) a1 in
+      not (Term.eq_constr t t1 &&
+           Term.eq_constr f f1 && CArray.for_all2 Term.eq_constr a a1) in
+    x :: uniquize (List.filter neq xs) in
+
+((fun env c h ~k -> 
+  do_once upat_that_matched (fun () -> 
+    let failed_because_of_TC = ref false in
+    try
+      if not all_instances then match_upats_FO upats env sigma0 ise c;
+      failed_because_of_TC:=match_upats_HO ~on_instance upats env sigma0 ise c;
+      raise NoMatch
+    with FoundUnif sigma_u -> 0,[sigma_u]
+    | (NoMatch|NoProgress) when all_instances && instances () <> [] ->
+      0, uniquize (instances ())
+    | NoMatch when (not raise_NoMatch) ->
+      if !failed_because_of_TC then
+        errorstrm (source ()++strbrk"matches but type classes inference fails")
+      else
+        errorstrm (source () ++ str "does not match any subterm of the goal")
+    | NoProgress when (not raise_NoMatch) ->
+        let dir = match upats_origin with Some (d,_) -> d | _ ->
+          CErrors.anomaly (str"mk_tpattern_matcher with no upats_origin") in
+        errorstrm (str"all matches of "++source()++
+          str"are equal to the " ++ pr_dir_side (inv_dir dir))
+    | NoProgress -> raise NoMatch);
+  let sigma, _, ({up_f = pf; up_a = pa} as u) =
+    if all_instances then assert_done_multires upat_that_matched
+    else List.hd (snd(assert_done upat_that_matched)) in
+(*   pp(lazy(str"sigma@tmatch=" ++ pr_evar_map None sigma)); *)
+  if !skip_occ then ((*ignore(k env u.up_t 0);*) c) else
+  let match_EQ = match_EQ env sigma u in
+  let pn = Array.length pa in
+  let rec subst_loop (env,h as acc) c' =
+    if !skip_occ then c' else
+    let f, a = splay_app sigma c' in
+    if Array.length a >= pn && match_EQ f && unif_EQ_args env sigma pa a then
+      let a1, a2 = Array.chop (Array.length pa) a in
+      let fa1 = mkApp (f, a1) in
+      let f' = if subst_occ () then k env u.up_t fa1 h else fa1 in
+      mkApp (f', Array.map_left (subst_loop acc) a2)
+    else
+      (* TASSI: clear letin values to avoid unfolding *)
+      let inc_h rd (env,h') =
+        let ctx_item =
+          match rd with
+          | Context.Rel.Declaration.LocalAssum _ as x -> x
+          | Context.Rel.Declaration.LocalDef (x,_,y) ->
+              Context.Rel.Declaration.LocalAssum(x,y) in
+        Environ.push_rel ctx_item env, h' + 1 in
+      let f' = map_constr_with_binders_left_to_right inc_h subst_loop acc f in
+      mkApp (f', Array.map_left (subst_loop acc) a) in
+  subst_loop (env,h) c) : find_P),
+((fun () ->
+  let sigma, uc, ({up_f = pf; up_a = pa} as u) =
+    match !upat_that_matched with
+    | Some (_,x) -> List.hd x | None when raise_NoMatch -> raise NoMatch
+    | None -> CErrors.anomaly (str"companion function never called") in
+  let p' = mkApp (pf, pa) in
+  if max_occ <= !nocc then p', u.up_dir, (sigma, uc, u.up_t)
+  else errorstrm (str"Only " ++ int !nocc ++ str" < " ++ int max_occ ++
+        str(String.plural !nocc " occurence") ++ match upats_origin with
+        | None -> str" of" ++ spc() ++ pr_constr_pat p'
+        | Some (dir,rule) -> str" of the " ++ pr_dir_side dir ++ fnl() ++
+            ws 4 ++ pr_constr_pat p' ++ fnl () ++ 
+            str"of " ++ pr_constr_pat rule)) : conclude)
+
+type ('ident, 'term) ssrpattern = 
+  | T of 'term
+  | In_T of 'term
+  | X_In_T of 'ident * 'term     
+  | In_X_In_T of 'ident * 'term     
+  | E_In_X_In_T of 'term * 'ident * 'term     
+  | E_As_X_In_T of 'term * 'ident * 'term     
+        
+let pr_pattern = function
+  | T t -> prl_term t
+  | In_T t -> str "in " ++ prl_term t
+  | X_In_T (x,t) -> prl_term x ++ str " in " ++ prl_term t
+  | In_X_In_T (x,t) -> str "in " ++ prl_term x ++ str " in " ++ prl_term t
+  | E_In_X_In_T (e,x,t) ->
+      prl_term e ++ str " in " ++ prl_term x ++ str " in " ++ prl_term t
+  | E_As_X_In_T (e,x,t) ->
+      prl_term e ++ str " as " ++ prl_term x ++ str " in " ++ prl_term t
+
+let pr_pattern_w_ids = function
+  | T t -> prl_term t
+  | In_T t -> str "in " ++ prl_term t
+  | X_In_T (x,t) -> pr_id x ++ str " in " ++ prl_term t
+  | In_X_In_T (x,t) -> str "in " ++ pr_id x ++ str " in " ++ prl_term t
+  | E_In_X_In_T (e,x,t) ->
+      prl_term e ++ str " in " ++ pr_id x ++ str " in " ++ prl_term t
+  | E_As_X_In_T (e,x,t) ->
+      prl_term e ++ str " as " ++ pr_id x ++ str " in " ++ prl_term t
+
+let pr_pattern_aux pr_constr = function
+  | T t -> pr_constr t
+  | In_T t -> str "in " ++ pr_constr t
+  | X_In_T (x,t) -> pr_constr x ++ str " in " ++ pr_constr t
+  | In_X_In_T (x,t) -> str "in " ++ pr_constr x ++ str " in " ++ pr_constr t
+  | E_In_X_In_T (e,x,t) ->
+      pr_constr e ++ str " in " ++ pr_constr x ++ str " in " ++ pr_constr t
+  | E_As_X_In_T (e,x,t) ->
+      pr_constr e ++ str " as " ++ pr_constr x ++ str " in " ++ pr_constr t
+let pp_pattern (sigma, p) =
+  pr_pattern_aux (fun t -> pr_constr_pat (pi3 (nf_open_term sigma sigma t))) p
+let pr_cpattern = pr_term
+let pr_rpattern _ _ _ = pr_pattern
+
+let pr_option f = function None -> mt() | Some x -> f x
+let pr_ssrpattern _ _ _ = pr_option pr_pattern
+let pr_pattern_squarep = pr_option (fun r -> str "[" ++ pr_pattern r ++ str "]")
+let pr_ssrpattern_squarep _ _ _ = pr_pattern_squarep
+let pr_pattern_roundp = pr_option (fun r -> str "(" ++ pr_pattern r ++ str ")")
+let pr_ssrpattern_roundp  _ _ _ = pr_pattern_roundp
+
+let wit_rpatternty = add_genarg "rpatternty" pr_pattern
+
+let glob_ssrterm gs = function
+  | k, (_, Some c) -> k,
+      let x = Tacintern.intern_constr gs c in
+      fst x, Some c
+  | ct -> ct
+
+(* This piece of code asserts the following notations are reserved *)
+(* Reserved Notation "( a 'in' b )"        (at level 0).           *)
+(* Reserved Notation "( a 'as' b )"        (at level 0).           *)
+(* Reserved Notation "( a 'in' b 'in' c )" (at level 0).           *)
+(* Reserved Notation "( a 'as' b 'in' c )" (at level 0).           *)
+let glob_cpattern gs p =
+  pp(lazy(str"globbing pattern: " ++ pr_term p));
+  let glob x = snd (glob_ssrterm gs (mk_lterm x)) in
+  let encode k s l =
+    let name = Name (id_of_string ("_ssrpat_" ^ s)) in
+    k, (mkRCast mkRHole (mkRLambda name mkRHole (mkRApp mkRHole l)), None) in
+  let bind_in t1 t2 =
+    let d = dummy_loc in let n = Name (destCVar t1) in
+    fst (glob (mkCCast d (mkCHole d) (mkCLambda d n (mkCHole d) t2))) in
+  let check_var t2 = if not (isCVar t2) then
+    loc_error (constr_loc t2) "Only identifiers are allowed here" in
+  match p with
+  | _, (_, None) as x -> x
+  | k, (v, Some t) as orig ->
+     if k = 'x' then glob_ssrterm gs ('(', (v, Some t)) else
+     match t with
+     | CNotation(_, "( _ in _ )", ([t1; t2], [], [])) ->
+         (try match glob t1, glob t2 with
+         | (r1, None), (r2, None) -> encode k "In" [r1;r2]
+         | (r1, Some _), (r2, Some _) when isCVar t1 ->
+             encode k "In" [r1; r2; bind_in t1 t2]
+         | (r1, Some _), (r2, Some _) -> encode k "In" [r1; r2]
+         | _ -> CErrors.anomaly (str"where are we?")
+         with _ when isCVar t1 -> encode k "In" [bind_in t1 t2])
+     | CNotation(_, "( _ in _ in _ )", ([t1; t2; t3], [], [])) ->
+         check_var t2; encode k "In" [fst (glob t1); bind_in t2 t3]
+     | CNotation(_, "( _ as _ )", ([t1; t2], [], [])) ->
+         encode k "As" [fst (glob t1); fst (glob t2)]
+     | CNotation(_, "( _ as _ in _ )", ([t1; t2; t3], [], [])) ->
+         check_var t2; encode k "As" [fst (glob t1); bind_in t2 t3]
+     | _ -> glob_ssrterm gs orig
+;;
+
+let glob_rpattern s p =
+  match p with
+  | T t -> T (glob_cpattern s t)
+  | In_T t -> In_T (glob_ssrterm s t)
+  | X_In_T(x,t) -> X_In_T (x,glob_ssrterm s t)
+  | In_X_In_T(x,t) -> In_X_In_T (x,glob_ssrterm s t)
+  | E_In_X_In_T(e,x,t) -> E_In_X_In_T (glob_ssrterm s e,x,glob_ssrterm s t)
+  | E_As_X_In_T(e,x,t) -> E_As_X_In_T (glob_ssrterm s e,x,glob_ssrterm s t)
+
+let subst_ssrterm s (k, c) = k, Tacsubst.subst_glob_constr_and_expr s c
+
+let subst_rpattern s = function
+  | T t -> T (subst_ssrterm s t)
+  | In_T t -> In_T (subst_ssrterm s t)
+  | X_In_T(x,t) -> X_In_T (x,subst_ssrterm s t)
+  | In_X_In_T(x,t) -> In_X_In_T (x,subst_ssrterm s t)
+  | E_In_X_In_T(e,x,t) -> E_In_X_In_T (subst_ssrterm s e,x,subst_ssrterm s t)
+  | E_As_X_In_T(e,x,t) -> E_As_X_In_T (subst_ssrterm s e,x,subst_ssrterm s t)
+
+ARGUMENT EXTEND rpattern
+  TYPED AS rpatternty
+  PRINTED BY pr_rpattern
+  GLOBALIZED BY glob_rpattern
+  SUBSTITUTED BY subst_rpattern
+  | [ lconstr(c) ] -> [ T (mk_lterm c) ]
+  | [ "in" lconstr(c) ] -> [ In_T (mk_lterm c) ]
+  | [ lconstr(x) "in" lconstr(c) ] -> 
+    [ X_In_T (mk_lterm x, mk_lterm c) ]
+  | [ "in" lconstr(x) "in" lconstr(c) ] -> 
+    [ In_X_In_T (mk_lterm x, mk_lterm c) ]
+  | [ lconstr(e) "in" lconstr(x) "in" lconstr(c) ] -> 
+    [ E_In_X_In_T (mk_lterm e, mk_lterm x, mk_lterm c) ]
+  | [ lconstr(e) "as" lconstr(x) "in" lconstr(c) ] -> 
+    [ E_As_X_In_T (mk_lterm e, mk_lterm x, mk_lterm c) ]
+END
+
+
+
+type cpattern = char * glob_constr_and_expr
+let tag_of_cpattern = fst
+let loc_of_cpattern = loc_ofCG
+let cpattern_of_term t = t
+type occ = (bool * int list) option
+
+type rpattern = (cpattern, cpattern) ssrpattern
+let pr_rpattern = pr_pattern
+
+type pattern = Evd.evar_map * (Term.constr, Term.constr) ssrpattern
+
+
+let id_of_cpattern = function
+  | _,(_,Some (CRef (Ident (_, x), _))) -> Some x
+  | _,(_,Some (CAppExpl (_, (_, Ident (_, x), _), []))) -> Some x
+  | _,(GRef (_, VarRef x, _) ,None) -> Some x
+  | _ -> None
+let id_of_Cterm t = match id_of_cpattern t with
+  | Some x -> x
+  | None -> loc_error (loc_of_cpattern t) "Only identifiers are allowed here"
+
+let of_ftactic ftac gl =
+  let r = ref None in
+  let tac = Ftactic.run ftac (fun ans -> r := Some ans; Proofview.tclUNIT ()) in
+  let tac = Proofview.V82.of_tactic tac in
+  let { sigma = sigma } = tac gl in
+  let ans = match !r with
+  | None -> assert false (** If the tactic failed we should not reach this point *)
+  | Some ans -> ans
+  in
+  (sigma, ans)
+
+let interp_wit wit ist gl x = 
+  let globarg = in_gen (glbwit wit) x in
+  let arg = interp_genarg ist globarg in
+  let (sigma, arg) = of_ftactic arg gl in
+  sigma, Value.cast (topwit wit) arg
+let interp_constr = interp_wit wit_constr
+let interp_open_constr ist gl gc =
+  interp_wit wit_open_constr ist gl gc
+let pf_intern_term ist gl (_, c) = glob_constr ist (pf_env gl) c
+let interp_term ist gl (_, c) = (interp_open_constr ist gl c)
+let pr_ssrterm _ _ _ = pr_term
+let input_ssrtermkind strm = match Compat.get_tok (stream_nth 0 strm) with
+  | Tok.KEYWORD "(" -> '('
+  | Tok.KEYWORD "@" -> '@'
+  | _ -> ' '
+let ssrtermkind = Gram.Entry.of_parser "ssrtermkind" input_ssrtermkind
+
+let interp_ssrterm _ gl t = Tacmach.project gl, t
+
+ARGUMENT EXTEND cpattern
+     PRINTED BY pr_ssrterm
+     INTERPRETED BY interp_ssrterm
+     GLOBALIZED BY glob_cpattern SUBSTITUTED BY subst_ssrterm
+     RAW_PRINTED BY pr_ssrterm
+     GLOB_PRINTED BY pr_ssrterm
+| [ "Qed" constr(c) ] -> [ mk_lterm c ]
+END
+
+let (!@) = Compat.to_coqloc
+
+GEXTEND Gram
+  GLOBAL: cpattern;
+  cpattern: [[ k = ssrtermkind; c = constr ->
+    let pattern = mk_term k c in
+    if loc_ofCG pattern <> !@loc && k = '(' then mk_term 'x' c else pattern ]];
+END
+
+ARGUMENT EXTEND lcpattern
+     TYPED AS cpattern
+     PRINTED BY pr_ssrterm
+     INTERPRETED BY interp_ssrterm
+     GLOBALIZED BY glob_cpattern SUBSTITUTED BY subst_ssrterm
+     RAW_PRINTED BY pr_ssrterm
+     GLOB_PRINTED BY pr_ssrterm
+| [ "Qed" lconstr(c) ] -> [ mk_lterm c ]
+END
+
+GEXTEND Gram
+  GLOBAL: lcpattern;
+  lcpattern: [[ k = ssrtermkind; c = lconstr ->
+    let pattern = mk_term k c in
+    if loc_ofCG pattern <> !@loc && k = '(' then mk_term 'x' c else pattern ]];
+END
+
+let thin id sigma goal =
+  let ids = Id.Set.singleton id in
+  let env = Goal.V82.env sigma goal in
+  let cl = Goal.V82.concl sigma goal in
+  let evdref = ref (Evd.clear_metas sigma) in
+  let ans =
+    try Some (Evarutil.clear_hyps_in_evi env evdref (Environ.named_context_val env) cl ids)
+    with Evarutil.ClearDependencyError _ -> None
+  in
+  match ans with
+  | None -> sigma
+  | Some (hyps, concl) ->
+    let sigma = !evdref in
+    let (gl,ev,sigma) = Goal.V82.mk_goal sigma hyps concl (Goal.V82.extra sigma goal) in
+    let sigma = Goal.V82.partial_solution_to sigma goal gl ev in
+    sigma
+
+let pr_ist { lfun= lfun } =
+  prlist_with_sep spc
+    (fun (id, Geninterp.Val.Dyn(ty,_)) ->
+        pr_id id ++ str":" ++ Geninterp.Val.pr ty) (Id.Map.bindings lfun)
+
+let interp_pattern ?wit_ssrpatternarg ist gl red redty =
+  pp(lazy(str"interpreting: " ++ pr_pattern red));
+  pp(lazy(str" in ist: " ++ pr_ist ist));
+  let xInT x y = X_In_T(x,y) and inXInT x y = In_X_In_T(x,y) in
+  let inT x = In_T x and eInXInT e x t = E_In_X_In_T(e,x,t) in
+  let eAsXInT e x t = E_As_X_In_T(e,x,t) in
+  let mkG ?(k=' ') x = k,(x,None) in
+  let decode ist t ?reccall f g =
+    try match (pf_intern_term ist gl t) with
+    | GCast(_,GHole _,CastConv(GLambda(_,Name x,_,_,c))) -> f x (' ',(c,None))
+    | GVar(_,id)
+      when Id.Map.mem id ist.lfun &&
+           not(Option.is_empty reccall) &&
+           not(Option.is_empty wit_ssrpatternarg) ->
+        let v = Id.Map.find id ist.lfun in
+        Option.get reccall
+          (Value.cast (topwit (Option.get wit_ssrpatternarg)) v)
+    | it -> g t with e when CErrors.noncritical e -> g t in
+  let decodeG t f g = decode ist (mkG t) f g in
+  let bad_enc id _ = CErrors.anomaly (str"bad encoding for pattern "++str id) in
+  let cleanup_XinE h x rp sigma =
+    let h_k = match kind_of_term h with Evar (k,_) -> k | _ -> assert false in
+    let to_clean, update = (* handle rename if x is already used *)
+      let ctx = pf_hyps gl in
+      let len = Context.Named.length ctx in
+      let name = ref None in
+      try ignore(Context.Named.lookup x ctx); (name, fun k ->
+        if !name = None then
+        let nctx = Evd.evar_context (Evd.find sigma k) in
+        let nlen = Context.Named.length nctx in
+        if nlen > len then begin
+          name := Some (Context.Named.Declaration.get_id (List.nth nctx (nlen - len - 1)))
+        end)
+      with Not_found -> ref (Some x), fun _ -> () in
+    let sigma0 = project gl in
+    let new_evars =
+      let rec aux acc t = match kind_of_term t with
+      | Evar (k,_) ->
+          if k = h_k || List.mem k acc || Evd.mem sigma0 k then acc else
+          (update k; k::acc)
+      | _ -> fold_constr aux acc t in 
+      aux [] (Evarutil.nf_evar sigma rp) in
+    let sigma = 
+      List.fold_left (fun sigma e ->
+        if Evd.is_defined sigma e then sigma else (* clear may be recursive *)
+        if Option.is_empty !to_clean then sigma else
+        let name = Option.get !to_clean in
+        pp(lazy(pr_id name));
+        thin name sigma e)
+      sigma new_evars in
+    sigma in
+  let red = let rec decode_red (ist,red) = match red with
+    | T(k,(GCast (_,GHole _,(CastConv(GLambda (_,Name id,_,_,t)))),None))
+        when let id = string_of_id id in let len = String.length id in
+        (len > 8 && String.sub id 0 8 = "_ssrpat_") ->
+        let id = string_of_id id in let len = String.length id in
+        (match String.sub id 8 (len - 8), t with
+        | "In", GApp(_, _, [t]) -> decodeG t xInT (fun x -> T x)
+        | "In", GApp(_, _, [e; t]) -> decodeG t (eInXInT (mkG e)) (bad_enc id)
+        | "In", GApp(_, _, [e; t; e_in_t]) ->
+            decodeG t (eInXInT (mkG e))
+              (fun _ -> decodeG e_in_t xInT (fun _ -> assert false))
+        | "As", GApp(_, _, [e; t]) -> decodeG t (eAsXInT (mkG e)) (bad_enc id)
+        | _ -> bad_enc id ())
+    | T t -> decode ist ~reccall:decode_red t xInT (fun x -> T x)
+    | In_T t -> decode ist t inXInT inT
+    | X_In_T (e,t) -> decode ist t (eInXInT e) (fun x -> xInT (id_of_Cterm e) x)
+    | In_X_In_T (e,t) -> inXInT (id_of_Cterm e) t
+    | E_In_X_In_T (e,x,rp) -> eInXInT e (id_of_Cterm x) rp
+    | E_As_X_In_T (e,x,rp) -> eAsXInT e (id_of_Cterm x) rp in
+    decode_red (ist,red) in
+  pp(lazy(str"decoded as: " ++ pr_pattern_w_ids red));
+  let red = match redty with None -> red | Some ty -> let ty = ' ', ty in
+  match red with
+  | T t -> T (combineCG t ty (mkCCast (loc_ofCG t)) mkRCast)
+  | X_In_T (x,t) ->
+      let ty = pf_intern_term ist gl ty in
+      E_As_X_In_T (mkG (mkRCast mkRHole ty), x, t)
+  | E_In_X_In_T (e,x,t) ->
+      let ty = mkG (pf_intern_term ist gl ty) in
+      E_In_X_In_T (combineCG e ty (mkCCast (loc_ofCG t)) mkRCast, x, t)
+  | E_As_X_In_T (e,x,t) ->
+      let ty = mkG (pf_intern_term ist gl ty) in
+      E_As_X_In_T (combineCG e ty (mkCCast (loc_ofCG t)) mkRCast, x, t)
+  | red -> red in
+  pp(lazy(str"typed as: " ++ pr_pattern_w_ids red));
+  let mkXLetIn loc x (a,(g,c)) = match c with
+  | Some b -> a,(g,Some (mkCLetIn loc x (mkCHole loc) b))
+  | None -> a,(GLetIn (loc,x,(GHole (loc, BinderType x, IntroAnonymous, None)), g), None) in
+  match red with
+  | T t -> let sigma, t = interp_term ist gl t in sigma, T t
+  | In_T t -> let sigma, t = interp_term ist gl t in sigma, In_T t
+  | X_In_T (x, rp) | In_X_In_T (x, rp) ->
+    let mk x p = match red with X_In_T _ -> X_In_T(x,p) | _ -> In_X_In_T(x,p) in
+    let rp = mkXLetIn dummy_loc (Name x) rp in
+    let sigma, rp = interp_term ist gl rp in
+    let _, h, _, rp = destLetIn rp in
+    let sigma = cleanup_XinE h x rp sigma in
+    let rp = subst1 h (Evarutil.nf_evar sigma rp) in
+    sigma, mk h rp
+  | E_In_X_In_T(e, x, rp) | E_As_X_In_T (e, x, rp) ->
+    let mk e x p =
+      match red with E_In_X_In_T _ ->E_In_X_In_T(e,x,p)|_->E_As_X_In_T(e,x,p) in
+    let rp = mkXLetIn dummy_loc (Name x) rp in
+    let sigma, rp = interp_term ist gl rp in
+    let _, h, _, rp = destLetIn rp in
+    let sigma = cleanup_XinE h x rp sigma in
+    let rp = subst1 h (Evarutil.nf_evar sigma rp) in
+    let sigma, e = interp_term ist (re_sig (sig_it gl) sigma) e in
+    sigma, mk e h rp
+;;
+let interp_cpattern ist gl red redty = interp_pattern ist gl (T red) redty;;
+let interp_rpattern ~wit_ssrpatternarg ist gl red = interp_pattern ~wit_ssrpatternarg ist gl red None;;
+
+let id_of_pattern = function
+  | _, T t -> (match kind_of_term t with Var id -> Some id | _ -> None)
+  | _ -> None
+
+(* The full occurrence set *)
+let noindex = Some(false,[])
+
+(* calls do_subst on every sub-term identified by (pattern,occ) *)
+let eval_pattern ?raise_NoMatch env0 sigma0 concl0 pattern occ do_subst =
+  let fs sigma x = Reductionops.nf_evar sigma x in
+  let pop_evar sigma e p =
+    let { Evd.evar_body = e_body } as e_def = Evd.find sigma e in
+    let e_body = match e_body with Evar_defined c -> c
+    | _ -> errorstrm (str "Matching the pattern " ++ pr_constr p ++
+          str " did not instantiate ?" ++ int (Evar.repr e) ++ spc () ++
+          str "Does the variable bound by the \"in\" construct occur "++
+          str "in the pattern?") in
+    let sigma = 
+      Evd.add (Evd.remove sigma e) e {e_def with Evd.evar_body = Evar_empty} in
+    sigma, e_body in
+  let ex_value hole =
+    match kind_of_term hole with Evar (e,_) -> e | _ -> assert false in
+  let mk_upat_for ?hack env sigma0 (sigma, t) ?(p=t) ok =
+    let sigma,pat= mk_tpattern ?hack env sigma0 (sigma,p) ok L2R (fs sigma t) in
+    sigma, [pat] in
+  match pattern with
+  | None -> do_subst env0 concl0 concl0 1
+  | Some (sigma, (T rp | In_T rp)) -> 
+    let rp = fs sigma rp in
+    let ise = create_evar_defs sigma in
+    let occ = match pattern with Some (_, T _) -> occ | _ -> noindex in
+    let rp = mk_upat_for env0 sigma0 (ise, rp) all_ok in
+    let find_T, end_T = mk_tpattern_matcher ?raise_NoMatch sigma0 occ rp in
+    let concl = find_T env0 concl0 1 do_subst in
+    let _ = end_T () in
+    concl
+  | Some (sigma, (X_In_T (hole, p) | In_X_In_T (hole, p))) ->
+    let p = fs sigma p in
+    let occ = match pattern with Some (_, X_In_T _) -> occ | _ -> noindex in
+    let ex = ex_value hole in
+    let rp = mk_upat_for ~hack:true env0 sigma0 (sigma, p) all_ok in
+    let find_T, end_T = mk_tpattern_matcher sigma0 noindex rp in
+    (* we start from sigma, so hole is considered a rigid head *)
+    let holep = mk_upat_for env0 sigma (sigma, hole) all_ok in
+    let find_X, end_X = mk_tpattern_matcher ?raise_NoMatch sigma occ holep in
+    let concl = find_T env0 concl0 1 (fun env c _ h ->
+      let p_sigma = unify_HO env (create_evar_defs sigma) c p in
+      let sigma, e_body = pop_evar p_sigma ex p in
+      fs p_sigma (find_X env (fs sigma p) h 
+        (fun env _ -> do_subst env e_body))) in
+    let _ = end_X () in let _ = end_T () in 
+    concl
+  | Some (sigma, E_In_X_In_T (e, hole, p)) ->
+    let p, e = fs sigma p, fs sigma e in
+    let ex = ex_value hole in
+    let rp = mk_upat_for ~hack:true env0 sigma0 (sigma, p) all_ok in
+    let find_T, end_T = mk_tpattern_matcher sigma0 noindex rp in
+    let holep = mk_upat_for env0 sigma (sigma, hole) all_ok in
+    let find_X, end_X = mk_tpattern_matcher sigma noindex holep in
+    let re = mk_upat_for env0 sigma0 (sigma, e) all_ok in
+    let find_E, end_E = mk_tpattern_matcher ?raise_NoMatch sigma0 occ re in
+    let concl = find_T env0 concl0 1 (fun env c _ h ->
+      let p_sigma = unify_HO env (create_evar_defs sigma) c p in
+      let sigma, e_body = pop_evar p_sigma ex p in
+      fs p_sigma (find_X env (fs sigma p) h (fun env c _ h ->
+        find_E env e_body h do_subst))) in
+    let _ = end_E () in let _ = end_X () in let _ = end_T () in
+    concl
+  | Some (sigma, E_As_X_In_T (e, hole, p)) ->
+    let p, e = fs sigma p, fs sigma e in
+    let ex = ex_value hole in
+    let rp = 
+      let e_sigma = unify_HO env0 sigma hole e in
+      e_sigma, fs e_sigma p in
+    let rp = mk_upat_for ~hack:true env0 sigma0 rp all_ok in
+    let find_TE, end_TE = mk_tpattern_matcher sigma0 noindex rp in
+    let holep = mk_upat_for env0 sigma (sigma, hole) all_ok in
+    let find_X, end_X = mk_tpattern_matcher sigma occ holep in
+    let concl = find_TE env0 concl0 1 (fun env c _ h ->
+      let p_sigma = unify_HO env (create_evar_defs sigma) c p in
+      let sigma, e_body = pop_evar p_sigma ex p in
+      fs p_sigma (find_X env (fs sigma p) h (fun env c _ h ->
+        let e_sigma = unify_HO env sigma e_body e in
+        let e_body = fs e_sigma e in
+        do_subst env e_body e_body h))) in
+    let _ = end_X () in let _ = end_TE () in
+    concl
+;;
+
+let redex_of_pattern ?(resolve_typeclasses=false) env (sigma, p) =
+  let e = match p with
+  | In_T _ | In_X_In_T _ -> CErrors.anomaly (str"pattern without redex")
+  | T e | X_In_T (e, _) | E_As_X_In_T (e, _, _) | E_In_X_In_T (e, _, _) -> e in
+  let sigma =
+    if not resolve_typeclasses then sigma
+    else Typeclasses.resolve_typeclasses ~fail:false env sigma in
+  Reductionops.nf_evar sigma e, Evd.evar_universe_context sigma
+
+let fill_occ_pattern ?raise_NoMatch env sigma cl pat occ h =
+  let do_make_rel, occ =
+    if occ = Some(true,[]) then false, Some(false,[1]) else true, occ in
+  let find_R, conclude =
+    let r = ref None in
+    (fun env c _ h' ->
+       do_once r (fun () -> c, Evd.empty_evar_universe_context);
+       if do_make_rel then mkRel (h'+h-1) else c),
+    (fun _ -> if !r = None then redex_of_pattern env pat else assert_done r) in
+  let cl = eval_pattern ?raise_NoMatch env sigma cl (Some pat) occ find_R in
+  let e = conclude cl in
+  e, cl
+;;
+
+(* clenup interface for external use *)
+let mk_tpattern ?p_origin env sigma0 sigma_t f dir c = 
+  mk_tpattern ?p_origin env sigma0 sigma_t f dir c
+;;
+
+let pf_fill_occ env concl occ sigma0 p (sigma, t) ok h =
+ let ise = create_evar_defs sigma in
+ let ise, u = mk_tpattern env sigma0 (ise,t) ok L2R p in
+ let find_U, end_U =
+   mk_tpattern_matcher ~raise_NoMatch:true sigma0 occ (ise,[u]) in
+ let concl = find_U env concl h (fun _ _ _ -> mkRel) in
+ let rdx, _, (sigma, uc, p) = end_U () in
+ sigma, uc, p, concl, rdx
+
+let fill_occ_term env cl occ sigma0 (sigma, t) =
+  try
+    let sigma',uc,t',cl,_= pf_fill_occ env cl occ sigma0 t (sigma, t) all_ok 1 in
+    if sigma' != sigma0 then CErrors.error "matching impacts evars"
+    else cl, (Evd.merge_universe_context sigma' uc, t')
+  with NoMatch -> try
+    let sigma', uc, t' =
+      unif_end env sigma0 (create_evar_defs sigma) t (fun _ -> true) in
+    if sigma' != sigma0 then raise NoMatch
+    else cl, (Evd.merge_universe_context sigma' uc, t')
+  with _ ->
+    errorstrm (str "partial term " ++ pr_constr_pat t
+            ++ str " does not match any subterm of the goal")
+
+let pf_fill_occ_term gl occ t =
+  let sigma0 = project gl and env = pf_env gl and concl = pf_concl gl in
+  let cl,(_,t) = fill_occ_term env concl occ sigma0 t in
+  cl, t
+
+let cpattern_of_id id = ' ', (GRef (dummy_loc, VarRef  id, None), None)
+
+let is_wildcard = function
+  | _,(_,Some (CHole _)|GHole _,None) -> true
+  | _ -> false
+
+(* "ssrpattern" *)
+let pr_ssrpatternarg _ _ _ (_,cpat) = pr_rpattern cpat
+let pr_ssrpatternarg_glob _ _ _ cpat = pr_rpattern cpat
+let interp_ssrpatternarg ist gl p = project gl, (ist, p)
+
+ARGUMENT EXTEND ssrpatternarg
+  PRINTED BY pr_ssrpatternarg
+  INTERPRETED BY interp_ssrpatternarg
+  GLOBALIZED BY glob_rpattern
+  RAW_PRINTED BY pr_ssrpatternarg_glob
+  GLOB_PRINTED BY pr_ssrpatternarg_glob
+| [ rpattern(pat) ] -> [ pat ]
+END
+  
+let pf_merge_uc uc gl =
+  re_sig (sig_it gl) (Evd.merge_universe_context (project gl) uc)
+
+let pf_unsafe_merge_uc uc gl =
+  re_sig (sig_it gl) (Evd.set_universe_context (project gl) uc)
+
+let interp_rpattern ist gl red = interp_rpattern ~wit_ssrpatternarg ist gl red
+
+let ssrpatterntac _ist (arg_ist,arg) gl =
+  let pat = interp_rpattern arg_ist gl arg in
+  let sigma0 = project gl in
+  let concl0 = pf_concl gl in
+  let (t, uc), concl_x =
+    fill_occ_pattern (Global.env()) sigma0 concl0 pat noindex 1 in
+  let gl, tty = pf_type_of gl t in
+  let concl = mkLetIn (Name (id_of_string "selected"), t, tty, concl_x) in
+  Proofview.V82.of_tactic (convert_concl concl DEFAULTcast) gl
+
+(* Register "ssrpattern" tactic *)
+let () =
+  let mltac _ ist =
+    let arg =
+      let v = Id.Map.find (Names.Id.of_string "pattern") ist.lfun in
+      Value.cast (topwit wit_ssrpatternarg) v in
+    Proofview.V82.tactic (ssrpatterntac ist arg) in
+  let name = { mltac_plugin = "ssrmatching_plugin"; mltac_tactic = "ssrpattern"; } in
+  let () = Tacenv.register_ml_tactic name [|mltac|] in
+  let tac =
+    TacFun ([Some (Id.of_string "pattern")],
+      TacML (Loc.ghost, { mltac_name = name; mltac_index = 0 }, [])) in
+  let obj () =
+    Tacenv.register_ltac true false (Id.of_string "ssrpattern") tac in
+  Mltop.declare_cache_obj obj "ssrmatching_plugin"
+
+let ssrinstancesof ist arg gl =
+  let ok rhs lhs ise = true in
+(*   not (Term.eq_constr lhs (Evarutil.nf_evar ise rhs)) in *)
+  let env, sigma, concl = pf_env gl, project gl, pf_concl gl in
+  let sigma0, cpat = interp_cpattern ist gl arg None in
+  let pat = match cpat with T x -> x | _ -> errorstrm (str"Not supported") in
+  let etpat, tpat = mk_tpattern env sigma (sigma0,pat) (ok pat) L2R pat in
+  let find, conclude =
+    mk_tpattern_matcher ~all_instances:true ~raise_NoMatch:true
+      sigma None (etpat,[tpat]) in
+  let print env p c _ = ppnl (hov 1 (str"instance:" ++ spc() ++ pr_constr p ++ spc() ++ str "matches:" ++ spc() ++ pr_constr c)); c in
+  ppnl (str"BEGIN INSTANCES");
+  try
+    while true do
+      ignore(find env concl 1 ~k:print)
+    done; raise NoMatch
+  with NoMatch -> ppnl (str"END INSTANCES"); tclIDTAC gl
+
+TACTIC EXTEND ssrinstoftpat
+| [ "ssrinstancesoftpat" cpattern(arg) ] -> [ Proofview.V82.tactic (ssrinstancesof ist arg) ]
+END
+
+(* We wipe out all the keywords generated by the grammar rules we defined. *)
+(* The user is supposed to Require Import ssreflect or Require ssreflect   *)
+(* and Import ssreflect.SsrSyntax to obtain these keywords and as a         *)
+(* consequence the extended ssreflect grammar.                             *)
+let () = CLexer.unfreeze frozen_lexer ;;
+
+(* vim: set filetype=ocaml foldmethod=marker: *)
diff --git a/plugins/ssrmatching/ssrmatching.mli b/plugins/ssrmatching/ssrmatching.mli
new file mode 100644
index 000000000..288a04e60
--- /dev/null
+++ b/plugins/ssrmatching/ssrmatching.mli
@@ -0,0 +1,241 @@
+(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* Distributed under the terms of CeCILL-B.                                  *)
+
+open Genarg
+open Tacexpr
+open Environ
+open Tacmach
+open Evd
+open Proof_type
+open Term
+
+(** ******** Small Scale Reflection pattern matching facilities ************* *)
+
+(** Pattern parsing *)
+
+(** The type of context patterns, the patterns of the [set] tactic and 
+    [:] tactical. These are patterns that identify a precise subterm. *)
+type cpattern
+val pr_cpattern : cpattern -> Pp.std_ppcmds
+
+(** CS cpattern: (f _), (X in t), (t in X in t), (t as X in t) *)
+val cpattern         : cpattern Pcoq.Gram.entry
+val wit_cpattern     : cpattern uniform_genarg_type
+
+(** OS cpattern: f _, (X in t), (t in X in t), (t as X in t) *)
+val lcpattern         : cpattern Pcoq.Gram.entry
+val wit_lcpattern     : cpattern uniform_genarg_type
+
+(** The type of rewrite patterns, the patterns of the [rewrite] tactic.
+    These patterns also include patterns that identify all the subterms
+    of a context (i.e. "in" prefix) *)
+type rpattern
+val pr_rpattern : rpattern -> Pp.std_ppcmds
+
+(** OS rpattern: f _, in t, X in t, in X in t, t in X in t, t as X in t *)
+val rpattern         : rpattern Pcoq.Gram.entry
+val wit_rpattern     : rpattern uniform_genarg_type
+
+(** Pattern interpretation and matching *)
+
+exception NoMatch
+exception NoProgress
+
+(** AST for [rpattern] (and consequently [cpattern]) *)
+type ('ident, 'term) ssrpattern =
+  | T of 'term
+  | In_T of 'term
+  | X_In_T of 'ident * 'term
+  | In_X_In_T of 'ident * 'term
+  | E_In_X_In_T of 'term * 'ident * 'term
+  | E_As_X_In_T of 'term * 'ident * 'term
+
+type pattern = evar_map * (constr, constr) ssrpattern
+val pp_pattern : pattern -> Pp.std_ppcmds
+
+(** Extracts the redex and applies to it the substitution part of the pattern.
+  @raise Anomaly if called on [In_T] or [In_X_In_T] *)
+val redex_of_pattern :
+  ?resolve_typeclasses:bool -> env -> pattern ->
+     constr Evd.in_evar_universe_context
+
+(** [interp_rpattern ise gl rpat] "internalizes" and "interprets" [rpat]
+    in the current [Ltac] interpretation signature [ise] and tactic input [gl]*)
+val interp_rpattern :
+  Tacinterp.interp_sign -> goal sigma ->
+  rpattern ->
+    pattern
+
+(** [interp_cpattern ise gl cpat ty] "internalizes" and "interprets" [cpat]
+    in the current [Ltac] interpretation signature [ise] and tactic input [gl].
+    [ty] is an optional type for the redex of [cpat] *)
+val interp_cpattern :
+  Tacinterp.interp_sign -> goal sigma ->
+  cpattern -> glob_constr_and_expr option ->
+    pattern
+
+(** The set of occurrences to be matched. The boolean is set to true
+ *  to signal the complement of this set (i.e. {-1 3}) *)
+type occ = (bool * int list) option
+
+(** [subst e p t i]. [i] is the number of binders
+    traversed so far, [p] the term from the pattern, [t] the matched one *)
+type subst = env -> constr -> constr -> int -> constr
+
+(** [eval_pattern b env sigma t pat occ subst] maps [t] calling [subst] on every
+    [occ] occurrence of [pat]. The [int] argument is the number of 
+    binders traversed. If [pat] is [None] then then subst is called on [t].
+    [t] must live in [env] and [sigma], [pat] must have been interpreted in 
+    (an extension of) [sigma]. 
+  @raise NoMatch if [pat] has no occurrence and [b] is [true] (default [false])
+  @return [t] where all [occ] occurrences of [pat] have been mapped using
+    [subst] *)
+val eval_pattern :
+  ?raise_NoMatch:bool ->
+  env -> evar_map -> constr ->
+  pattern option -> occ -> subst ->
+    constr
+
+(** [fill_occ_pattern b env sigma t pat occ h] is a simplified version of 
+    [eval_pattern]. 
+    It replaces all [occ] occurrences of [pat] in [t] with Rel [h]. 
+    [t] must live in [env] and [sigma], [pat] must have been interpreted in 
+    (an extension of) [sigma]. 
+  @raise NoMatch if [pat] has no occurrence and [b] is [true] (default [false]) 
+  @return the instance of the redex of [pat] that was matched and [t]
+    transformed as described above. *)
+val fill_occ_pattern :
+  ?raise_NoMatch:bool ->
+  env -> evar_map -> constr ->
+  pattern -> occ -> int ->
+    constr Evd.in_evar_universe_context * constr
+
+(** *************************** Low level APIs ****************************** *)
+
+(* The primitive matching facility. It matches of a term with holes, like 
+   the T pattern above, and calls a continuation on its occurrences. *)
+
+type ssrdir = L2R | R2L
+val pr_dir_side : ssrdir -> Pp.std_ppcmds
+
+(** a pattern for a term with wildcards *)
+type tpattern
+
+(** [mk_tpattern env sigma0 sigma_p ok p_origin dir t] compiles a term [t] 
+    living in [env] [sigma] (an extension of [sigma0]) intro a [tpattern].
+    The [tpattern] can hold a (proof) term [p] and a diction [dir]. The [ok]
+    callback is used to filter occurrences.
+  @return the compiled [tpattern] and its [evar_map]
+  @raise UserEerror is the pattern is a wildcard *)
+val mk_tpattern :
+  ?p_origin:ssrdir * constr ->
+  env -> evar_map ->
+  evar_map * constr ->
+  (constr -> evar_map -> bool) ->
+  ssrdir -> constr ->
+    evar_map * tpattern
+
+(** [findP env t i k] is a stateful function that finds the next occurrence 
+    of a tpattern and calls the callback [k] to map the subterm matched. 
+    The [int] argument passed to [k] is the number of binders traversed so far 
+    plus the initial value [i]. 
+  @return [t] where the subterms identified by the selected occurrences of 
+    the patter have been mapped using [k]
+  @raise NoMatch if the raise_NoMatch flag given to [mk_tpattern_matcher] is
+    [true] and if the pattern did not match 
+  @raise UserEerror if the raise_NoMatch flag given to [mk_tpattern_matcher] is
+    [false] and if the pattern did not match *)
+type find_P =
+  env -> constr -> int -> k:subst -> constr
+
+(** [conclude ()] asserts that all mentioned ocurrences have been visited.
+  @return the instance of the pattern, the evarmap after the pattern
+    instantiation, the proof term and the ssrdit stored in the tpattern
+  @raise UserEerror if too many occurrences were specified *)
+type conclude =
+  unit -> constr * ssrdir * (evar_map * Evd.evar_universe_context * constr)
+
+(** [mk_tpattern_matcher b o sigma0 occ sigma_tplist] creates a pair 
+    a function [find_P] and [conclude] with the behaviour explained above.
+    The flag [b] (default [false]) changes the error reporting behaviour
+    of [find_P] if none of the [tpattern] matches. The argument [o] can
+    be passed to tune the [UserError] eventually raised (useful if the 
+    pattern is coming from the LHS/RHS of an equation) *)
+val mk_tpattern_matcher :
+  ?all_instances:bool ->
+  ?raise_NoMatch:bool ->
+  ?upats_origin:ssrdir * constr ->
+  evar_map -> occ -> evar_map * tpattern list ->
+    find_P * conclude
+
+(** Example of [mk_tpattern_matcher] to implement 
+    [rewrite \{occ\}\[in t\]rules].
+    It first matches "in t" (called [pat]), then in all matched subterms 
+    it matches the LHS of the rules using [find_R].
+    [concl0] is the initial goal, [concl] will be the goal where some terms
+    are replaced by a De Bruijn index. The [rw_progress] extra check
+    selects only occurrences that are not rewritten to themselves (e.g.
+    an occurrence "x + x" rewritten with the commutativity law of addition 
+    is skipped) {[
+  let find_R, conclude = match pat with
+  | Some (_, In_T _) ->
+      let aux (sigma, pats) (d, r, lhs, rhs) =
+        let sigma, pat = 
+          mk_tpattern env0 sigma0 (sigma, r) (rw_progress rhs) d lhs in
+        sigma, pats @ [pat] in
+      let rpats = List.fold_left aux (r_sigma, []) rules in
+      let find_R, end_R = mk_tpattern_matcher sigma0 occ rpats in
+      find_R ~k:(fun _ _ h -> mkRel h), 
+      fun cl -> let rdx, d, r = end_R () in (d,r),rdx
+  | _ -> ... in
+  let concl = eval_pattern env0 sigma0 concl0 pat occ find_R in
+  let (d, r), rdx = conclude concl in ]} *)
+
+(* convenience shortcut: [pf_fill_occ_term gl occ (sigma,t)] returns
+ * the conclusion of [gl] where [occ] occurrences of [t] have been replaced
+ * by [Rel 1] and the instance of [t] *)
+val pf_fill_occ_term : goal sigma -> occ -> evar_map * constr -> constr * constr
+
+(* It may be handy to inject a simple term into the first form of cpattern *)
+val cpattern_of_term : char * glob_constr_and_expr -> cpattern
+
+(** Helpers to make stateful closures. Example: a [find_P] function may be 
+    called many times, but the pattern instantiation phase is performed only the
+    first time. The corresponding [conclude] has to return the instantiated
+    pattern redex. Since it is up to [find_P] to raise [NoMatch] if the pattern
+    has no instance, [conclude] considers it an anomaly if the pattern did
+    not match *)
+
+(** [do_once r f] calls [f] and updates the ref only once *)
+val do_once : 'a option ref -> (unit -> 'a) -> unit
+(** [assert_done r] return the content of r. @raise Anomaly is r is [None] *)
+val assert_done : 'a option ref -> 'a
+
+(** Very low level APIs.
+    these are calls to evarconv's [the_conv_x] followed by
+    [solve_unif_constraints_with_heuristics] and [resolve_typeclasses].
+    In case of failure they raise [NoMatch] *)
+
+val unify_HO : env -> evar_map -> constr -> constr -> evar_map
+val pf_unify_HO : goal sigma -> constr -> constr -> goal sigma
+
+(** Some more low level functions needed to implement the full SSR language
+    on top of the former APIs *)
+val tag_of_cpattern : cpattern -> char
+val loc_of_cpattern : cpattern -> Loc.t
+val id_of_pattern : pattern -> Names.variable option
+val is_wildcard : cpattern -> bool
+val cpattern_of_id : Names.variable -> cpattern
+val cpattern_of_id : Names.variable -> cpattern
+val pr_constr_pat : constr -> Pp.std_ppcmds
+val pf_merge_uc : Evd.evar_universe_context -> goal Evd.sigma -> goal Evd.sigma
+val pf_unsafe_merge_uc : Evd.evar_universe_context -> goal Evd.sigma -> goal Evd.sigma
+
+(* One can also "Set SsrMatchingDebug" from a .v *)
+val debug : bool -> unit
+
+(* One should delimit a snippet with "Set SsrMatchingProfiling" and
+ * "Unset SsrMatchingProfiling" to get timings *)
+val profile : bool -> unit
+
+(* eof *)
diff --git a/plugins/ssrmatching/ssrmatching.v b/plugins/ssrmatching/ssrmatching.v
new file mode 100644
index 000000000..829ee05e1
--- /dev/null
+++ b/plugins/ssrmatching/ssrmatching.v
@@ -0,0 +1,26 @@
+(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* Distributed under the terms of CeCILL-B.                                  *)
+Declare ML Module "ssrmatching_plugin".
+
+Module SsrMatchingSyntax.
+
+(* Reserve the notation for rewrite patterns so that the user is not allowed  *)
+(* to declare it at a different level.                                        *)
+Reserved Notation "( a 'in' b )"        (at level 0).
+Reserved Notation "( a 'as' b )"        (at level 0).
+Reserved Notation "( a 'in' b 'in' c )" (at level 0).
+Reserved Notation "( a 'as' b 'in' c )" (at level 0).
+
+(* Notation to define shortcuts for the "X in t" part of a pattern.           *)
+Notation "( X 'in' t )" := (_ : fun X => t) : ssrpatternscope.
+Delimit Scope ssrpatternscope with pattern.
+
+(* Some shortcuts for recurrent "X in t" parts.                               *)
+Notation RHS := (X in _ = X)%pattern.
+Notation LHS := (X in X = _)%pattern.
+
+End SsrMatchingSyntax.
+
+Export SsrMatchingSyntax.
+
+Tactic Notation "ssrpattern" ssrpatternarg(p) := ssrpattern p .
diff --git a/plugins/ssrmatching/ssrmatching_plugin.mlpack b/plugins/ssrmatching/ssrmatching_plugin.mlpack
new file mode 100644
index 000000000..5fb1f1567
--- /dev/null
+++ b/plugins/ssrmatching/ssrmatching_plugin.mlpack
@@ -0,0 +1 @@
+Ssrmatching
diff --git a/plugins/ssrmatching/vo.itarget b/plugins/ssrmatching/vo.itarget
new file mode 100644
index 000000000..b0eb38834
--- /dev/null
+++ b/plugins/ssrmatching/vo.itarget
@@ -0,0 +1 @@
+ssrmatching.vo
diff --git a/plugins/syntax/ascii_syntax.ml b/plugins/syntax/ascii_syntax.ml
index 67c9dd0a3..ed8cc6ab0 100644
--- a/plugins/syntax/ascii_syntax.ml
+++ b/plugins/syntax/ascii_syntax.ml
@@ -6,8 +6,12 @@
 (*         *       GNU Lesser General Public License Version 2.1       *)
 (***********************************************************************)
 
+(* Poor's man DECLARE PLUGIN *)
+let __coq_plugin_name = "ascii_syntax_plugin"
+let () = Mltop.add_known_module __coq_plugin_name
+
 open Pp
-open Errors
+open CErrors
 open Util
 open Names
 open Glob_term
@@ -48,8 +52,8 @@ let interp_ascii_string dloc s =
       if Int.equal (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
+	user_err ~loc:dloc ~hdr:"interp_ascii_string"
+	 (str "Expects a single character or a three-digits ascii code.") in
   interp_ascii dloc p
 
 let uninterp_ascii r =
diff --git a/plugins/syntax/ascii_syntax_plugin.mllib b/plugins/syntax/ascii_syntax_plugin.mllib
deleted file mode 100644
index b00f92506..000000000
--- a/plugins/syntax/ascii_syntax_plugin.mllib
+++ /dev/null
@@ -1,2 +0,0 @@
-Ascii_syntax
-Ascii_syntax_plugin_mod
diff --git a/plugins/syntax/ascii_syntax_plugin.mlpack b/plugins/syntax/ascii_syntax_plugin.mlpack
new file mode 100644
index 000000000..7b9213a0e
--- /dev/null
+++ b/plugins/syntax/ascii_syntax_plugin.mlpack
@@ -0,0 +1 @@
+Ascii_syntax
diff --git a/plugins/syntax/nat_syntax.ml b/plugins/syntax/nat_syntax.ml
index fe9386039..ab262fea7 100644
--- a/plugins/syntax/nat_syntax.ml
+++ b/plugins/syntax/nat_syntax.ml
@@ -6,6 +6,10 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
+(* Poor's man DECLARE PLUGIN *)
+let __coq_plugin_name = "nat_syntax_plugin"
+let () = Mltop.add_known_module __coq_plugin_name
+
 (* This file defines the printer for natural numbers in [nat] *)
 
 (*i*)
@@ -13,7 +17,7 @@ open Glob_term
 open Bigint
 open Coqlib
 open Pp
-open Errors
+open CErrors
 (*i*)
 
 (**********************************************************************)
@@ -22,14 +26,16 @@ open Errors
 
 let threshold = of_int 5000
 
+let warn_large_nat =
+  CWarnings.create ~name:"large-nat" ~category:"numbers"
+    (fun () -> strbrk "Stack overflow or segmentation fault happens when " ++
+                 strbrk "working with large numbers in nat (observed threshold " ++
+                 strbrk "may vary from 5000 to 70000 depending on your system " ++
+                 strbrk "limits and on the command executed).")
+
 let nat_of_int dloc n =
   if is_pos_or_zero n then begin
-      if less_than threshold n then
-	Feedback.msg_warning
-	  (strbrk "Stack overflow or segmentation fault happens when " ++
-	   strbrk "working with large numbers in nat (observed threshold " ++
-	   strbrk "may vary from 5000 to 70000 depending on your system " ++
-	   strbrk "limits and on the command executed).");
+      if less_than threshold n then warn_large_nat ();
       let ref_O = GRef (dloc, glob_O, None) in
       let ref_S = GRef (dloc, glob_S, None) in
       let rec mk_nat acc n =
@@ -41,8 +47,8 @@ let nat_of_int dloc n =
       mk_nat ref_O n
     end
   else
-      user_err_loc (dloc, "nat_of_int",
-        str "Cannot interpret a negative number as a number of type nat")
+      user_err ~hdr:"nat_of_int"
+       (str "Cannot interpret a negative number as a number of type nat")
 
 (************************************************************************)
 (* Printing via scopes *)
diff --git a/plugins/syntax/nat_syntax_plugin.mllib b/plugins/syntax/nat_syntax_plugin.mllib
deleted file mode 100644
index 69b0cb20f..000000000
--- a/plugins/syntax/nat_syntax_plugin.mllib
+++ /dev/null
@@ -1,2 +0,0 @@
-Nat_syntax
-Nat_syntax_plugin_mod
diff --git a/plugins/syntax/nat_syntax_plugin.mlpack b/plugins/syntax/nat_syntax_plugin.mlpack
new file mode 100644
index 000000000..39bdd62f4
--- /dev/null
+++ b/plugins/syntax/nat_syntax_plugin.mlpack
@@ -0,0 +1 @@
+Nat_syntax
diff --git a/plugins/syntax/numbers_syntax.ml b/plugins/syntax/numbers_syntax.ml
index fe9f1319e..a25ddb062 100644
--- a/plugins/syntax/numbers_syntax.ml
+++ b/plugins/syntax/numbers_syntax.ml
@@ -6,6 +6,10 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
+(* Poor's man DECLARE PLUGIN *)
+let __coq_plugin_name = "numbers_syntax_plugin"
+let () = Mltop.add_known_module __coq_plugin_name
+
 (* digit-based syntax for int31, bigN bigZ and bigQ *)
 
 open Bigint
@@ -96,7 +100,7 @@ let int31_of_pos_bigint dloc n =
   GApp (dloc, ref_construct, List.rev (args 31 n))
 
 let error_negative dloc =
-  Errors.user_err_loc (dloc, "interp_int31", Pp.str "int31 are only non-negative numbers.")
+  CErrors.user_err ~loc:dloc ~hdr:"interp_int31" (Pp.str "int31 are only non-negative numbers.")
 
 let interp_int31 dloc n =
   if is_pos_or_zero n then
@@ -180,12 +184,12 @@ let bigN_of_pos_bigint dloc n =
   let word = word_of_pos_bigint dloc h n in
   let args =
     if h < n_inlined then [word]
-    else [Nat_syntax.nat_of_int dloc (of_int (h-n_inlined));word]
+    else [Nat_syntax_plugin.Nat_syntax.nat_of_int dloc (of_int (h-n_inlined));word]
   in
   GApp (dloc, ref_constructor, args)
 
 let bigN_error_negative dloc =
-  Errors.user_err_loc (dloc, "interp_bigN", Pp.str "bigN are only non-negative numbers.")
+  CErrors.user_err ~loc:dloc ~hdr:"interp_bigN" (Pp.str "bigN are only non-negative numbers.")
 
 let interp_bigN dloc n =
   if is_pos_or_zero n then
diff --git a/plugins/syntax/numbers_syntax_plugin.mllib b/plugins/syntax/numbers_syntax_plugin.mllib
deleted file mode 100644
index ebc0bb202..000000000
--- a/plugins/syntax/numbers_syntax_plugin.mllib
+++ /dev/null
@@ -1,2 +0,0 @@
-Numbers_syntax
-Numbers_syntax_plugin_mod
diff --git a/plugins/syntax/numbers_syntax_plugin.mlpack b/plugins/syntax/numbers_syntax_plugin.mlpack
new file mode 100644
index 000000000..e48c00a0d
--- /dev/null
+++ b/plugins/syntax/numbers_syntax_plugin.mlpack
@@ -0,0 +1 @@
+Numbers_syntax
diff --git a/plugins/syntax/r_syntax.ml b/plugins/syntax/r_syntax.ml
index 05d73f9ec..3ae2d45f3 100644
--- a/plugins/syntax/r_syntax.ml
+++ b/plugins/syntax/r_syntax.ml
@@ -10,6 +10,10 @@ open Util
 open Names
 open Globnames
 
+(* Poor's man DECLARE PLUGIN *)
+let __coq_plugin_name = "r_syntax_plugin"
+let () = Mltop.add_known_module __coq_plugin_name
+
 exception Non_closed_number
 
 (**********************************************************************)
diff --git a/plugins/syntax/r_syntax_plugin.mllib b/plugins/syntax/r_syntax_plugin.mllib
deleted file mode 100644
index 5c173a140..000000000
--- a/plugins/syntax/r_syntax_plugin.mllib
+++ /dev/null
@@ -1,2 +0,0 @@
-R_syntax
-R_syntax_plugin_mod
diff --git a/plugins/syntax/r_syntax_plugin.mlpack b/plugins/syntax/r_syntax_plugin.mlpack
new file mode 100644
index 000000000..d4ee75ea4
--- /dev/null
+++ b/plugins/syntax/r_syntax_plugin.mlpack
@@ -0,0 +1 @@
+R_syntax
diff --git a/plugins/syntax/string_syntax.ml b/plugins/syntax/string_syntax.ml
index 2e696f391..de0fa77ef 100644
--- a/plugins/syntax/string_syntax.ml
+++ b/plugins/syntax/string_syntax.ml
@@ -7,10 +7,14 @@
 (***********************************************************************)
 
 open Globnames
-open Ascii_syntax
+open Ascii_syntax_plugin.Ascii_syntax
 open Glob_term
 open Coqlib
 
+(* Poor's man DECLARE PLUGIN *)
+let __coq_plugin_name = "string_syntax_plugin"
+let () = Mltop.add_known_module __coq_plugin_name
+
 exception Non_closed_string
 
 (* make a string term from the string s *)
diff --git a/plugins/syntax/string_syntax_plugin.mllib b/plugins/syntax/string_syntax_plugin.mllib
deleted file mode 100644
index b108c9e00..000000000
--- a/plugins/syntax/string_syntax_plugin.mllib
+++ /dev/null
@@ -1,2 +0,0 @@
-String_syntax
-String_syntax_plugin_mod
diff --git a/plugins/syntax/string_syntax_plugin.mlpack b/plugins/syntax/string_syntax_plugin.mlpack
new file mode 100644
index 000000000..45d6e0fa2
--- /dev/null
+++ b/plugins/syntax/string_syntax_plugin.mlpack
@@ -0,0 +1 @@
+String_syntax
diff --git a/plugins/syntax/z_syntax.ml b/plugins/syntax/z_syntax.ml
index 53c1b5d7a..b7b5fb8a5 100644
--- a/plugins/syntax/z_syntax.ml
+++ b/plugins/syntax/z_syntax.ml
@@ -7,11 +7,15 @@
 (************************************************************************)
 
 open Pp
-open Errors
+open CErrors
 open Util
 open Names
 open Bigint
 
+(* Poor's man DECLARE PLUGIN *)
+let __coq_plugin_name = "z_syntax_plugin"
+let () = Mltop.add_known_module __coq_plugin_name
+
 exception Non_closed_number
 
 (**********************************************************************)
@@ -53,8 +57,8 @@ let pos_of_bignat dloc x =
   pos_of x
 
 let error_non_positive dloc =
-  user_err_loc (dloc, "interp_positive",
-    str "Only strictly positive numbers in type \"positive\".")
+  user_err ~loc:dloc ~hdr:"interp_positive"
+   (str "Only strictly positive numbers in type \"positive\".")
 
 let interp_positive dloc n =
   if is_strictly_pos n then pos_of_bignat dloc n
@@ -109,7 +113,7 @@ let n_of_binnat dloc pos_or_neg n =
     GRef (dloc, glob_N0, None)
 
 let error_negative dloc =
-  user_err_loc (dloc, "interp_N", str "No negative numbers in type \"N\".")
+  user_err ~loc:dloc ~hdr:"interp_N" (str "No negative numbers in type \"N\".")
 
 let n_of_int dloc n =
   if is_pos_or_zero n then n_of_binnat dloc true n
diff --git a/plugins/syntax/z_syntax_plugin.mllib b/plugins/syntax/z_syntax_plugin.mllib
deleted file mode 100644
index 36d41acc2..000000000
--- a/plugins/syntax/z_syntax_plugin.mllib
+++ /dev/null
@@ -1,2 +0,0 @@
-Z_syntax
-Z_syntax_plugin_mod
diff --git a/plugins/syntax/z_syntax_plugin.mlpack b/plugins/syntax/z_syntax_plugin.mlpack
new file mode 100644
index 000000000..411260c04
--- /dev/null
+++ b/plugins/syntax/z_syntax_plugin.mlpack
@@ -0,0 +1 @@
+Z_syntax
diff --git a/pretyping/arguments_renaming.ml b/pretyping/arguments_renaming.ml
index ca1d0b7fb..1bd03491a 100644
--- a/pretyping/arguments_renaming.ml
+++ b/pretyping/arguments_renaming.ml
@@ -13,15 +13,17 @@ open Term
 open Environ
 open Util
 open Libobject
+
+module NamedDecl = Context.Named.Declaration
 (*i*)
 
 let name_table =
-  Summary.ref (Refmap.empty : Name.t list list Refmap.t)
+  Summary.ref (Refmap.empty : Name.t list Refmap.t)
     ~name:"rename-arguments"
 
 type req =
   | ReqLocal
-  | ReqGlobal of global_reference * Name.t list list
+  | ReqGlobal of global_reference * Name.t list
 
 let load_rename_args _ (_, (_, (r, names))) =
   name_table := Refmap.add r names !name_table
@@ -48,8 +50,8 @@ let discharge_rename_args = function
      (try 
        let vars,_,_ = section_segment_of_reference c in
        let c' = pop_global_reference c in
-       let var_names = List.map (fun (id, _,_,_) -> Name id) vars in
-       let names' = List.map (fun l -> var_names @ l) names in
+       let var_names = List.map (fst %> NamedDecl.get_id %> Name.mk_name) vars in
+       let names' = var_names @ names in
        Some (ReqGlobal (c', names), (c', names'))
      with Not_found -> Some req)
   | _ -> None
@@ -83,7 +85,7 @@ let rec rename_prod c = function
       | _ -> c
         
 let rename_type ty ref =
-  try rename_prod ty (List.hd (arguments_names ref))
+  try rename_prod ty (arguments_names ref)
   with Not_found -> ty
 
 let rename_type_of_constant env c =
diff --git a/pretyping/arguments_renaming.mli b/pretyping/arguments_renaming.mli
index a33405501..e123e7786 100644
--- a/pretyping/arguments_renaming.mli
+++ b/pretyping/arguments_renaming.mli
@@ -11,10 +11,10 @@ open Globnames
 open Environ
 open Term
 
-val rename_arguments : bool -> global_reference -> Name.t list list -> unit
+val rename_arguments : bool -> global_reference -> Name.t list -> unit
 
-(** [Not_found] is raised is no names are defined for [r] *)
-val arguments_names : global_reference -> Name.t list list
+(** [Not_found] is raised if no names are defined for [r] *)
+val arguments_names : global_reference -> Name.t list
 
 val rename_type_of_constant : env -> pconstant -> types
 val rename_type_of_inductive : env -> pinductive -> types
diff --git a/pretyping/cases.ml b/pretyping/cases.ml
index b8fb61e35..63c2dde18 100644
--- a/pretyping/cases.ml
+++ b/pretyping/cases.ml
@@ -7,7 +7,7 @@
 (************************************************************************)
 
 open Pp
-open Errors
+open CErrors
 open Util
 open Names
 open Nameops
@@ -32,6 +32,9 @@ open Evd
 open Sigma.Notations
 open Context.Rel.Declaration
 
+module RelDecl = Context.Rel.Declaration
+module NamedDecl = Context.Named.Declaration
+
 (* Pattern-matching errors *)
 
 type pattern_matching_error =
@@ -45,30 +48,32 @@ type pattern_matching_error =
 
 exception PatternMatchingError of env * evar_map * pattern_matching_error
 
-let raise_pattern_matching_error (loc,env,sigma,te) =
-  Loc.raise loc (PatternMatchingError(env,sigma,te))
+let raise_pattern_matching_error ?loc (env,sigma,te) =
+  Loc.raise ?loc (PatternMatchingError(env,sigma,te))
 
-let error_bad_pattern_loc loc env sigma cstr ind =
-  raise_pattern_matching_error
-    (loc, env, sigma, BadPattern (cstr,ind))
+let error_bad_pattern ?loc env sigma cstr ind =
+  raise_pattern_matching_error ?loc
+    (env, sigma, BadPattern (cstr,ind))
 
-let error_bad_constructor_loc loc env cstr ind =
-  raise_pattern_matching_error
-    (loc, env, Evd.empty, BadConstructor (cstr,ind))
+let error_bad_constructor ?loc env cstr ind =
+  raise_pattern_matching_error ?loc
+    (env, Evd.empty, BadConstructor (cstr,ind))
 
-let error_wrong_numarg_constructor_loc loc env c n =
-  raise_pattern_matching_error (loc, env, Evd.empty, WrongNumargConstructor(c,n))
+let error_wrong_numarg_constructor ?loc env c n =
+  raise_pattern_matching_error ?loc (env, Evd.empty, WrongNumargConstructor(c,n))
 
-let error_wrong_numarg_inductive_loc loc env c n =
-  raise_pattern_matching_error (loc, env, Evd.empty, WrongNumargInductive(c,n))
+let error_wrong_numarg_inductive ?loc env c n =
+  raise_pattern_matching_error ?loc (env, Evd.empty, WrongNumargInductive(c,n))
 
-let rec list_try_compile f = function
-  | [a] -> f a
-  | [] -> anomaly (str "try_find_f")
+let list_try_compile f l =
+  let rec aux errors = function
+  | [] -> if errors = [] then anomaly (str "try_find_f") else iraise (List.last errors)
   | h::t ->
       try f h
-      with UserError _ | TypeError _ | PretypeError _ | PatternMatchingError _ ->
-	    list_try_compile f t
+      with UserError _ | TypeError _ | PretypeError _ | PatternMatchingError _ as e ->
+	    let e = CErrors.push e in
+	    aux (e::errors) t in
+  aux [] l
 
 let force_name =
   let nx = Name default_dependent_ident in function Anonymous -> nx | na -> na
@@ -270,9 +275,9 @@ let rec find_row_ind = function
 let inductive_template evdref env tmloc ind =
   let indu = evd_comb1 (Evd.fresh_inductive_instance env) evdref ind in
   let arsign = inductive_alldecls_env env indu in
-  let hole_source = match tmloc with
-    | Some loc -> fun i -> (loc, Evar_kinds.TomatchTypeParameter (ind,i))
-    | None -> fun _ -> (Loc.ghost, Evar_kinds.InternalHole) in
+  let hole_source i = match tmloc with
+    | Some loc -> (loc, Evar_kinds.TomatchTypeParameter (ind,i))
+    | None -> (Loc.ghost, Evar_kinds.TomatchTypeParameter (ind,i)) in
    let (_,evarl,_) =
     List.fold_right
       (fun decl (subst,evarl,n) ->
@@ -479,32 +484,31 @@ let check_and_adjust_constructor env 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 env cstr nb_args_constr
+	    error_wrong_numarg_constructor ~loc env cstr nb_args_constr
       else
 	(* Try to insert a coercion *)
 	try
 	  Coercion.inh_pattern_coerce_to loc env pat ind' ind
 	with Not_found ->
-	  error_bad_constructor_loc loc env cstr ind
+	  error_bad_constructor ~loc env cstr ind
 
 let check_all_variables env sigma typ mat =
   List.iter
     (fun eqn -> match current_pattern eqn with
        | PatVar (_,id) -> ()
        | PatCstr (loc,cstr_sp,_,_) ->
-	   error_bad_pattern_loc loc env sigma cstr_sp typ)
+	   error_bad_pattern ~loc env sigma cstr_sp typ)
     mat
 
 let check_unused_pattern env eqn =
   if not !(eqn.used) then
-    raise_pattern_matching_error
-      (eqn.eqn_loc, env, Evd.empty, UnusedClause eqn.patterns)
+    raise_pattern_matching_error ~loc:eqn.eqn_loc (env, Evd.empty, UnusedClause eqn.patterns)
 
 let set_used_pattern eqn = eqn.used := true
 
 let extract_rhs pb =
   match pb.mat with
-    | [] -> errorlabstrm "build_leaf" (msg_may_need_inversion())
+    | [] -> user_err ~hdr:"build_leaf" (msg_may_need_inversion())
     | eqn::_ ->
 	set_used_pattern eqn;
         eqn.rhs
@@ -605,7 +609,7 @@ let relocate_index_tomatch n1 n2 =
       NonDepAlias :: genrec depth rest
   | Abstract (i,d) :: rest ->
       let i = relocate_rel n1 n2 depth i in
-      Abstract (i, map_constr (relocate_index n1 n2 depth) d)
+      Abstract (i, RelDecl.map_constr (relocate_index n1 n2 depth) d)
       :: genrec (depth+1) rest in
   genrec 0
 
@@ -638,7 +642,7 @@ let replace_tomatch n c =
   | NonDepAlias  :: rest ->
       NonDepAlias :: replrec depth rest
   | Abstract (i,d) :: rest ->
-      Abstract (i, map_constr (replace_term n c depth) d)
+      Abstract (i, RelDecl.map_constr (replace_term n c depth) d)
       :: replrec (depth+1) rest in
   replrec 0
 
@@ -663,7 +667,7 @@ let rec liftn_tomatch_stack n depth = function
       NonDepAlias :: liftn_tomatch_stack n depth rest
   | Abstract (i,d)::rest ->
       let i = if i<depth then i else i+n in
-      Abstract (i, map_constr (liftn n depth) d)
+      Abstract (i, RelDecl.map_constr (liftn n depth) d)
       ::(liftn_tomatch_stack n (depth+1) rest)
 
 let lift_tomatch_stack n = liftn_tomatch_stack n 1
@@ -731,7 +735,7 @@ let get_names env sign eqns =
 (* We now replace the names y1 .. yn y by the actual names       *)
 (* xi1 .. xin xi to be found in the i-th clause of the matrix    *)
 
-let recover_initial_subpattern_names = List.map2 set_name
+let recover_initial_subpattern_names = List.map2 RelDecl.set_name
 
 let recover_and_adjust_alias_names names sign =
   let rec aux = function
@@ -756,11 +760,11 @@ let push_rels_eqn_with_names sign eqn =
   push_rels_eqn sign eqn
 
 let push_generalized_decl_eqn env n decl eqn =
-  match get_name decl with
+  match RelDecl.get_name decl with
   | Anonymous ->
       push_rels_eqn [decl] eqn
   | Name _ ->
-      push_rels_eqn [set_name (get_name (Environ.lookup_rel n eqn.rhs.rhs_env)) decl] eqn
+      push_rels_eqn [RelDecl.set_name (RelDecl.get_name (Environ.lookup_rel n eqn.rhs.rhs_env)) decl] eqn
 
 let drop_alias_eqn eqn =
   { eqn with alias_stack = List.tl eqn.alias_stack }
@@ -768,7 +772,7 @@ let drop_alias_eqn eqn =
 let push_alias_eqn alias eqn =
   let aliasname = List.hd eqn.alias_stack in
   let eqn = drop_alias_eqn eqn in
-  let alias = set_name aliasname alias in
+  let alias = RelDecl.set_name aliasname alias in
   push_rels_eqn [alias] eqn
 
 (**********************************************************************)
@@ -845,7 +849,7 @@ let subst_predicate (subst,copt) ccl tms =
     | Some c -> c::subst in
   substnl_predicate sigma 0 ccl tms
 
-let specialize_predicate_var (cur,typ,dep) tms ccl =
+let specialize_predicate_var (cur,typ,dep) env tms ccl =
   let c = match dep with
   | Anonymous -> None
   | Name _ -> Some cur
@@ -853,7 +857,9 @@ let specialize_predicate_var (cur,typ,dep) tms ccl =
   let l =
     match typ with
     | IsInd (_, IndType (_, _), []) -> []
-    | IsInd (_, IndType (_, realargs), names) -> realargs
+    | IsInd (_, IndType (indf, realargs), names) ->
+       let arsign,_ = get_arity env indf in
+       subst_of_rel_context_instance arsign realargs
     | NotInd _ -> [] in
   subst_predicate (l,c) ccl tms
 
@@ -1195,7 +1201,7 @@ let rec generalize_problem names pb = function
       | LocalDef (Anonymous,_,_) -> pb', deps
       | _ ->
 	 (* for better rendering *)
-	let d = map_type (whd_betaiota !(pb.evdref)) d in
+	let d = RelDecl.map_type (whd_betaiota !(pb.evdref)) d in
         let tomatch = lift_tomatch_stack 1 pb'.tomatch in
         let tomatch = relocate_index_tomatch (i+1) 1 tomatch in
         { pb' with
@@ -1223,7 +1229,7 @@ let build_branch initial current realargs deps (realnames,curname) pb arsign eqn
   (* that had matched constructor C *)
   let cs_args = const_info.cs_args in
   let names,aliasname = get_names pb.env cs_args eqns in
-  let typs = List.map2 set_name names cs_args
+  let typs = List.map2 RelDecl.set_name names cs_args
   in
 
   (* We build the matrix obtained by expanding the matching on *)
@@ -1273,7 +1279,7 @@ let build_branch initial current realargs deps (realnames,curname) pb arsign eqn
   let typs' =
     List.map2
       (fun (tm, (tmtyp,_), decl) deps ->
-        let na = get_name decl in
+        let na = RelDecl.get_name decl in
 	let na = match curname, na with
 	| Name _, Anonymous -> curname
 	| Name _, Name _ -> na
@@ -1305,8 +1311,7 @@ let build_branch initial current realargs deps (realnames,curname) pb arsign eqn
   let submat = adjust_impossible_cases pb pred tomatch submat in
   let () = match submat with
   | [] ->
-    raise_pattern_matching_error
-      (Loc.ghost, pb.env, Evd.empty, NonExhaustive (complete_history history))
+    raise_pattern_matching_error (pb.env, Evd.empty, NonExhaustive (complete_history history))
   | _ -> ()
   in
 
@@ -1329,14 +1334,6 @@ let build_branch initial current realargs deps (realnames,curname) pb arsign eqn
 
 *)
 
-let mk_case pb (ci,pred,c,brs) =
-  let mib = lookup_mind (fst ci.ci_ind) pb.env in
-    match mib.mind_record with
-    | Some (Some (_, cs, pbs)) ->
-      Reduction.beta_appvect brs.(0) 
-	(Array.map (fun p -> mkProj (Projection.make p true, c)) cs)
-    | _ -> mkCase (ci,pred,c,brs)
-
 (**********************************************************************)
 (* Main compiling descent *)
 let rec compile pb =
@@ -1383,7 +1380,9 @@ and match_current pb (initial,tomatch) =
 	      pred current indt (names,dep) tomatch in
 	  let ci = make_case_info pb.env (fst mind) pb.casestyle in
 	  let pred = nf_betaiota !(pb.evdref) pred in
-	  let case = mk_case pb (ci,pred,current,brvals) in
+	  let case =
+	    make_case_or_project pb.env indf ci pred current brvals
+	  in
 	  Typing.check_allowed_sort pb.env !(pb.evdref) mind current pred;
 	  { uj_val = applist (case, inst);
 	    uj_type = prod_applist typ inst }
@@ -1394,7 +1393,7 @@ and match_current pb (initial,tomatch) =
 and shift_problem ((current,t),_,na) pb =
   let ty = type_of_tomatch t in
   let tomatch = lift_tomatch_stack 1 pb.tomatch in
-  let pred = specialize_predicate_var (current,t,na) pb.tomatch pb.pred in
+  let pred = specialize_predicate_var (current,t,na) pb.env pb.tomatch pb.pred in
   let pb =
     { pb with
        env = push_rel (LocalDef (na,current,ty)) pb.env;
@@ -1411,7 +1410,7 @@ and shift_problem ((current,t),_,na) pb =
    are already introduced in the context, we avoid creating aliases to
    themselves by treating this case specially. *)
 and pop_problem ((current,t),_,na) pb =
-  let pred = specialize_predicate_var (current,t,na) pb.tomatch pb.pred in
+  let pred = specialize_predicate_var (current,t,na) pb.env pb.tomatch pb.pred in
   let pb =
     { pb with
        pred = pred;
@@ -1664,8 +1663,7 @@ let abstract_tycon loc env evdref subst tycon extenv t =
 	List.map (fun a -> not (isRel a) || dependent a u
                            || Int.Set.mem (destRel a) depvl) inst in
       let named_filter =
-        let open Context.Named.Declaration in
-	List.map (fun d -> dependent (mkVar (get_id d)) u)
+	List.map (fun d -> dependent (mkVar (NamedDecl.get_id d)) u)
 	  (named_context extenv) in
       let filter = Filter.make (rel_filter @ named_filter) in
       let candidates = u :: List.map mkRel vl in
@@ -1708,7 +1706,7 @@ let build_inversion_problem loc env sigma tms t =
     let id = next_name_away (named_hd env t Anonymous) avoid in
     PatVar (Loc.ghost,Name id), ((id,t)::subst, id::avoid) in
   let rec reveal_pattern t (subst,avoid as acc) =
-    match kind_of_term (whd_betadeltaiota env sigma t) with
+    match kind_of_term (whd_all env sigma t) with
     | Construct (cstr,u) -> PatCstr (Loc.ghost,cstr,[],Anonymous), acc
     | App (f,v) when isConstruct f ->
 	let cstr,u = destConstruct f in
@@ -1761,7 +1759,7 @@ let build_inversion_problem loc env sigma tms t =
 
   let sub_tms =
     List.map2 (fun deps (tm, (tmtyp,_), decl) ->
-      let na = if List.is_empty deps then Anonymous else force_name (get_name decl) in
+      let na = if List.is_empty deps then Anonymous else force_name (RelDecl.get_name decl) in
       Pushed (true,((tm,tmtyp),deps,na)))
       dep_sign decls in
   let subst = List.map (fun (na,t) -> (na,lift n t)) subst in
@@ -1801,14 +1799,10 @@ let build_inversion_problem loc env sigma tms t =
 	          it = None } } ] in
   (* [pb] is the auxiliary pattern-matching serving as skeleton for the
       return type of the original problem Xi *)
-  (* let sigma, s = Evd.new_sort_variable sigma in *)
-(*FIXME TRY *)
-  (* let sigma, s = Evd.new_sort_variable univ_flexible sigma in *)
   let s' = Retyping.get_sort_of env sigma t in
   let sigma, s = Evd.new_sort_variable univ_flexible_alg sigma in
   let sigma = Evd.set_leq_sort env sigma s' s in
   let evdref = ref sigma in
-  (* let ty = evd_comb1 (refresh_universes false) evdref ty in *)
   let pb =
     { env       = pb_env;
       evdref    = evdref;
@@ -1828,7 +1822,7 @@ let build_initial_predicate arsign pred =
   let rec buildrec n pred tmnames = function
     | [] -> List.rev tmnames,pred
     | (decl::realdecls)::lnames ->
-        let na = get_name decl in
+        let na = RelDecl.get_name decl in
         let n' = n + List.length realdecls in
         buildrec (n'+1) pred (force_name na::tmnames) lnames
     | _ -> assert false
@@ -1844,8 +1838,8 @@ let extract_arity_signature ?(dolift=true) env0 tomatchl tmsign =
 		       | None -> [LocalAssum (na, lift n typ)]
 		       | Some b -> [LocalDef (na, lift n b, lift n typ)])
 	    | Some (loc,_,_) ->
- 	    user_err_loc (loc,"",
-	    str"Unexpected type annotation for a term of non inductive type."))
+ 	    user_err ~loc 
+                (str"Unexpected type annotation for a term of non inductive type."))
       | IsInd (term,IndType(indf,realargs),_) ->
           let indf' = if dolift then lift_inductive_family n indf else indf in
 	  let ((ind,u),_) = dest_ind_family indf' in
@@ -1855,13 +1849,13 @@ let extract_arity_signature ?(dolift=true) env0 tomatchl tmsign =
 	    match t with
 	      | Some (loc,ind',realnal) ->
 		  if not (eq_ind ind ind') then
-		    user_err_loc (loc,"",str "Wrong inductive type.");
+		    user_err ~loc  (str "Wrong inductive type.");
 		  if not (Int.equal nrealargs_ctxt (List.length realnal)) then
 		      anomaly (Pp.str "Ill-formed 'in' clause in cases");
 		  List.rev realnal
 	      | None -> List.make nrealargs_ctxt Anonymous in
 	  LocalAssum (na, build_dependent_inductive env0 indf')
-	  ::(List.map2 set_name realnal arsign) in
+	  ::(List.map2 RelDecl.set_name realnal arsign) in
   let rec buildrec n = function
     | [],[] -> []
     | (_,tm)::ltm, (_,x)::tmsign ->
@@ -1881,7 +1875,7 @@ let inh_conv_coerce_to_tycon loc env evdref j tycon =
 (* We put the tycon inside the arity signature, possibly discovering dependencies. *)
 
 let prepare_predicate_from_arsign_tycon env sigma loc tomatchs arsign c =
-  let nar = List.fold_left (fun n sign -> List.length sign + n) 0 arsign in
+  let nar = List.fold_left (fun n sign -> Context.Rel.nhyps sign + n) 0 arsign in
   let subst, len =
     List.fold_right2 (fun (tm, tmtype) sign (subst, len) ->
       let signlen = List.length sign in
@@ -1942,14 +1936,22 @@ let prepare_predicate_from_arsign_tycon env sigma loc tomatchs arsign c =
  *)
 
 let prepare_predicate loc typing_fun env sigma tomatchs arsign tycon pred =
+  let refresh_tycon sigma t =
+    (** If we put the typing constraint in the term, it has to be
+       refreshed to preserve the invariant that no algebraic universe
+       can appear in the term.  *)
+    refresh_universes ~status:Evd.univ_flexible ~onlyalg:true (Some true)
+		      env sigma t
+  in
   let preds =
     match pred, tycon with
-    (* No type annotation *)
+    (* No return clause *)
     | None, Some t when not (noccur_with_meta 0 max_int t) ->
 	(* If the tycon is not closed w.r.t real variables, we try *)
         (* two different strategies *)
-	(* First strategy: we abstract the tycon wrt to the dependencies *)
-        let p1 =
+       (* First strategy: we abstract the tycon wrt to the dependencies *)
+         let sigma, t = refresh_tycon sigma t in
+         let p1 =
           prepare_predicate_from_arsign_tycon env sigma loc tomatchs arsign t in
 	(* Second strategy: we build an "inversion" predicate *)
 	let sigma2,pred2 = build_inversion_problem loc env sigma tomatchs t in
@@ -1960,7 +1962,7 @@ let prepare_predicate loc typing_fun env sigma tomatchs arsign tycon pred =
 	(* No dependent type constraint, or no constraints at all: *)
 	(* we use two strategies *)
         let sigma,t = match tycon with
-	| Some t -> sigma,t
+	| Some t -> refresh_tycon sigma t
 	| None -> 
           let sigma = Sigma.Unsafe.of_evar_map sigma in
           let Sigma ((t, _), sigma, _) =
@@ -1981,12 +1983,6 @@ let prepare_predicate loc typing_fun env sigma tomatchs arsign tycon pred =
       let evdref = ref sigma in
       let predcclj = typing_fun (mk_tycon (mkSort newt)) envar evdref rtntyp in
       let sigma = !evdref in
-      (* let sigma = Option.cata (fun tycon -> *)
-      (*     let na = Name (Id.of_string "x") in *)
-      (*     let tms = List.map (fun tm -> Pushed(tm,[],na)) tomatchs in *)
-      (*     let predinst = extract_predicate predcclj.uj_val tms in *)
-      (*     Coercion.inh_conv_coerce_to loc env !evdref predinst tycon) *)
-      (*   !evdref tycon in *)
       let predccl = (j_nf_evar sigma predcclj).uj_val in
       [sigma, predccl]
   in
@@ -2032,7 +2028,9 @@ let mk_JMeq evdref typ x typ' y =
 let mk_JMeq_refl evdref typ x = 
   papp evdref coq_JMeq_refl [| typ; x |]
 
-let hole = GHole (Loc.ghost, Evar_kinds.QuestionMark (Evar_kinds.Define true), Misctypes.IntroAnonymous, None)
+let hole =
+  GHole (Loc.ghost, Evar_kinds.QuestionMark (Evar_kinds.Define false),
+         Misctypes.IntroAnonymous, None)
 
 let constr_of_pat env evdref arsign pat avoid =
   let rec typ env (ty, realargs) pat avoid =
@@ -2050,11 +2048,11 @@ let constr_of_pat env evdref arsign pat avoid =
 	let cind = inductive_of_constructor cstr in
 	let IndType (indf, _) = 
 	  try find_rectype env ( !evdref) (lift (-(List.length realargs)) ty)
-	  with Not_found -> error_case_not_inductive env 
+	  with Not_found -> error_case_not_inductive env !evdref
 	    {uj_val = ty; uj_type = Typing.unsafe_type_of env !evdref ty}
 	in
 	let (ind,u), params = dest_ind_family indf in
-	if not (eq_ind ind cind) then error_bad_constructor_loc l env cstr ind;
+	if not (eq_ind ind cind) then error_bad_constructor ~loc:l env cstr ind;
 	let cstrs = get_constructors env indf in
 	let ci = cstrs.(i-1) in
 	let nb_args_constr = ci.cs_nargs in
@@ -2062,7 +2060,7 @@ let constr_of_pat env evdref arsign pat avoid =
 	let patargs, args, sign, env, n, m, avoid =
 	  List.fold_right2
 	    (fun decl ua (patargs, args, sign, env, n, m, avoid)  ->
-               let t = get_type decl in
+               let t = RelDecl.get_type decl in
 	       let pat', sign', arg', typ', argtypargs, n', avoid =
 		 let liftt = liftn (List.length sign) (succ (List.length args)) t in
 		   typ env (substl args liftt, []) ua avoid
@@ -2102,8 +2100,8 @@ let constr_of_pat env evdref arsign pat avoid =
 		  (* Mark the equality as a hole *)
 		  pat', sign, lift i app, lift i apptype, realargs, n + i, avoid
   in
-  let pat', sign, patc, patty, args, z, avoid = typ env (get_type (List.hd arsign), List.tl arsign) pat avoid in
-    pat', (sign, patc, (get_type (List.hd arsign), args), pat'), avoid
+  let pat', sign, patc, patty, args, z, avoid = typ env (RelDecl.get_type (List.hd arsign), List.tl arsign) pat avoid in
+    pat', (sign, patc, (RelDecl.get_type (List.hd arsign), args), pat'), avoid
 
 
 (* shadows functional version *)
@@ -2134,7 +2132,7 @@ let vars_of_ctx ctx =
 		(GRef (Loc.ghost, delayed_force coq_eq_refl_ref, None)), 
 		   [hole; GVar (Loc.ghost, prev)])) :: vars
 	| _ ->
-	    match get_name decl with
+	    match RelDecl.get_name decl with
 		Anonymous -> invalid_arg "vars_of_ctx"
 	      | Name n -> n, GVar (Loc.ghost, n) :: vars)
       ctx (Id.of_string "vars_of_ctx_error", [])
@@ -2311,7 +2309,7 @@ let abstract_tomatch env tomatchs tycon =
 let build_dependent_signature env evdref avoid tomatchs arsign =
   let avoid = ref avoid in
   let arsign = List.rev arsign in
-  let allnames = List.rev_map (List.map get_name) arsign in
+  let allnames = List.rev_map (List.map RelDecl.get_name) arsign in
   let nar = List.fold_left (fun n names -> List.length names + n) 0 allnames in
   let eqs, neqs, refls, slift, arsign' =
     List.fold_left2
@@ -2328,14 +2326,14 @@ let build_dependent_signature env evdref avoid tomatchs arsign =
 		as much as possible *)
 	     let argsign = List.tl arsign in (* arguments in inverse application order *)
 	     let app_decl = List.hd arsign in (* The matched argument *)
-	     let appn = get_name app_decl in
-	     let appt = get_type app_decl in
+	     let appn = RelDecl.get_name app_decl in
+	     let appt = RelDecl.get_type app_decl in
 	     let argsign = List.rev argsign in (* arguments in application order *)
 	     let env', nargeqs, argeqs, refl_args, slift, argsign' =
 	       List.fold_left2
 		 (fun (env, nargeqs, argeqs, refl_args, slift, argsign') arg decl ->
-		    let name = get_name decl in
-		    let t = get_type decl in
+		    let name = RelDecl.get_name decl in
+		    let t = RelDecl.get_type decl in
 		    let argt = Retyping.get_type_of env !evdref arg in
 		    let eq, refl_arg =
 		      if Reductionops.is_conv env !evdref argt t then
@@ -2353,7 +2351,7 @@ let build_dependent_signature env evdref avoid tomatchs arsign =
 		    let previd, id =
 		      let name =
 			match kind_of_term arg with
-			Rel n -> get_name (lookup_rel n env)
+			Rel n -> RelDecl.get_name (lookup_rel n env)
 			| _ -> name
 		      in
 			make_prime avoid name
@@ -2362,7 +2360,7 @@ let build_dependent_signature env evdref avoid tomatchs arsign =
 		       (LocalAssum (Name (eq_id avoid previd), eq)) :: argeqs,
 		       refl_arg :: refl_args,
 		       pred slift,
-		       set_name (Name id) decl :: argsign'))
+		       RelDecl.set_name (Name id) decl :: argsign'))
 		 (env, neqs, [], [], slift, []) args argsign
 	     in
 	     let eq = mk_JMeq evdref
@@ -2377,13 +2375,13 @@ let build_dependent_signature env evdref avoid tomatchs arsign =
 		succ nargeqs,
 		refl_eq :: refl_args,
 		pred slift,
-		((set_name (Name id) app_decl :: argsign') :: arsigns))
+		((RelDecl.set_name (Name id) app_decl :: argsign') :: arsigns))
 
 	 | _ -> (* Non dependent inductive or not inductive, just use a regular equality *)
 	     let decl = match arsign with [x] -> x | _ -> assert(false) in
-	     let name = get_name decl in
+	     let name = RelDecl.get_name decl in
 	     let previd, id = make_prime avoid name in
-	     let arsign' = set_name (Name id) decl in
+	     let arsign' = RelDecl.set_name (Name id) decl in
 	     let tomatch_ty = type_of_tomatch ty in
 	     let eq =
 	       mk_eq evdref (lift nar tomatch_ty)
@@ -2434,7 +2432,7 @@ let compile_program_cases loc style (typing_function, evdref) tycon env
     match tycon' with
     | None -> let ev = mkExistential env evdref in ev, ev
     | Some t ->
-	let pred = 
+	let pred =
 	  match prepare_predicate_from_arsign_tycon env !evdref loc tomatchs sign t with
 	  | Some (evd, pred) -> evdref := evd; pred
 	  | None ->
@@ -2513,11 +2511,11 @@ let compile_program_cases loc style (typing_function, evdref) tycon env
 (* Main entry of the matching compilation                                 *)
 
 let compile_cases loc style (typing_fun, evdref) tycon env (predopt, tomatchl, eqns) =
-  if predopt == None && Flags.is_program_mode () then
-    compile_program_cases loc style (typing_fun, evdref) 
+  if predopt == None && Flags.is_program_mode () && Program.is_program_cases () then
+    compile_program_cases loc style (typing_fun, evdref)
       tycon env (predopt, tomatchl, eqns)
   else
-      
+
   (* We build the matrix of patterns and right-hand side *)
   let matx = matx_of_eqns env eqns in
 
@@ -2579,6 +2577,9 @@ let compile_cases loc style (typing_fun, evdref) tycon env (predopt, tomatchl, e
 	typing_function = typing_fun } in
 
     let j = compile pb in
+
+    (* We coerce to the tycon (if an elim predicate was provided) *)
+    let j = inh_conv_coerce_to_tycon loc env myevdref j tycon in
     evdref := !myevdref;
     j in
 
@@ -2589,6 +2590,4 @@ let compile_cases loc style (typing_fun, evdref) tycon env (predopt, tomatchl, e
   (* We check for unused patterns *)
   List.iter (check_unused_pattern env) matx;
 
-  (* We coerce to the tycon (if an elim predicate was provided) *)
-  inh_conv_coerce_to_tycon loc env evdref j tycon
-
+  j
diff --git a/pretyping/cases.mli b/pretyping/cases.mli
index d7fff8af4..d8fad1687 100644
--- a/pretyping/cases.mli
+++ b/pretyping/cases.mli
@@ -28,9 +28,9 @@ type pattern_matching_error =
 
 exception PatternMatchingError of env * evar_map * pattern_matching_error
 
-val error_wrong_numarg_constructor_loc : Loc.t -> env -> constructor -> int -> 'a
+val error_wrong_numarg_constructor : ?loc:Loc.t -> env -> constructor -> int -> 'a
 
-val error_wrong_numarg_inductive_loc : Loc.t -> env -> inductive -> int -> 'a
+val error_wrong_numarg_inductive   : ?loc:Loc.t -> env -> inductive -> int -> 'a
 
 val irrefutable : env -> cases_pattern -> bool
 
@@ -114,11 +114,11 @@ val compile : 'a pattern_matching_problem -> Environ.unsafe_judgment
 
 val prepare_predicate :            Loc.t ->
            (Evarutil.type_constraint ->
-            Environ.env -> Evd.evar_map ref -> 'a -> Environ.unsafe_judgment) ->
+            Environ.env -> Evd.evar_map ref -> glob_constr -> Environ.unsafe_judgment) ->
            Environ.env ->
            Evd.evar_map ->
            (Term.types * tomatch_type) list ->
            Context.Rel.t list ->
            Constr.constr option ->
-           'a option -> (Evd.evar_map * Names.name list * Term.constr) list
-
+           glob_constr option ->
+           (Evd.evar_map * Names.name list * Term.constr) list
diff --git a/pretyping/cbv.ml b/pretyping/cbv.ml
index afd86420e..84bf849e7 100644
--- a/pretyping/cbv.ml
+++ b/pretyping/cbv.ml
@@ -10,7 +10,7 @@ open Util
 open Names
 open Term
 open Vars
-open Closure
+open CClosure
 open Esubst
 
 (**** Call by value reduction ****)
@@ -156,7 +156,7 @@ let strip_appl head stack =
 
 (* Tests if fixpoint reduction is possible. *)
 let fixp_reducible flgs ((reci,i),_) stk =
-  if red_set flgs fIOTA then
+  if red_set flgs fFIX then
     match stk with
       | APP(appl,_) ->
           Array.length appl > reci.(i) &&
@@ -168,7 +168,7 @@ let fixp_reducible flgs ((reci,i),_) stk =
     false
 
 let cofixp_reducible flgs _ stk =
-  if red_set flgs fIOTA then
+  if red_set flgs fCOFIX then
     match stk with
       | (CASE _ | APP(_,CASE _)) -> true
       | _ -> false
@@ -296,19 +296,19 @@ and cbv_stack_value info env = function
 
     (* constructor in a Case -> IOTA *)
     | (CONSTR(((sp,n),u),[||]), APP(args,CASE(_,br,ci,env,stk)))
-            when red_set (info_flags info) fIOTA ->
+            when red_set (info_flags info) fMATCH ->
 	let cargs =
           Array.sub args ci.ci_npar (Array.length args - ci.ci_npar) in
         cbv_stack_term info (stack_app cargs stk) env br.(n-1)
 
     (* constructor of arity 0 in a Case -> IOTA *)
     | (CONSTR(((_,n),u),[||]), CASE(_,br,_,env,stk))
-            when red_set (info_flags info) fIOTA ->
+            when red_set (info_flags info) fMATCH ->
                     cbv_stack_term info stk env br.(n-1)
 
     (* constructor in a Projection -> IOTA *)
     | (CONSTR(((sp,n),u),[||]), APP(args,PROJ(p,pi,stk)))
-        when red_set (info_flags info) fIOTA && Projection.unfolded p ->
+        when red_set (info_flags info) fMATCH && Projection.unfolded p ->
       let arg = args.(pi.Declarations.proj_npars + pi.Declarations.proj_arg) in
 	cbv_stack_value info env (strip_appl arg stk)
 
diff --git a/pretyping/cbv.mli b/pretyping/cbv.mli
index de37d1fc5..87a03abbd 100644
--- a/pretyping/cbv.mli
+++ b/pretyping/cbv.mli
@@ -9,7 +9,7 @@
 open Names
 open Term
 open Environ
-open Closure
+open CClosure
 open Esubst
 
 (***********************************************************************
diff --git a/pretyping/classops.ml b/pretyping/classops.ml
index 55220f44c..30d100af9 100644
--- a/pretyping/classops.ml
+++ b/pretyping/classops.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-open Errors
+open CErrors
 open Util
 open Pp
 open Flags
@@ -297,7 +297,7 @@ let lookup_path_to_sort_from env sigma s =
 
 let get_coercion_constructor env coe =
   let c, _ =
-    Reductionops.whd_betadeltaiota_stack env Evd.empty coe.coe_value
+    Reductionops.whd_all_stack env Evd.empty coe.coe_value
   in
   match kind_of_term c with
   | Construct (cstr,u) ->
@@ -387,7 +387,7 @@ let add_coercion_in_graph (ic,source,target) =
   end;
   let is_ambig = match !ambig_paths with [] -> false | _ -> true in
   if is_ambig && is_verbose () then
-    Feedback.msg_warning (message_ambig !ambig_paths)
+    Feedback.msg_info (message_ambig !ambig_paths)
 
 type coercion = {
   coercion_type   : coe_typ;
@@ -538,7 +538,7 @@ let inheritance_graph () =
 let coercion_of_reference r =
   let ref = Nametab.global r in
   if not (coercion_exists ref) then
-    errorlabstrm "try_add_coercion"
+    user_err ~hdr:"try_add_coercion"
       (Nametab.pr_global_env Id.Set.empty ref ++ str" is not a coercion.");
   ref
 
diff --git a/pretyping/coercion.ml b/pretyping/coercion.ml
index 5c7adf1aa..2b860ae9c 100644
--- a/pretyping/coercion.ml
+++ b/pretyping/coercion.ml
@@ -14,7 +14,7 @@
    Corbineau, Feb 2008 *)
 (* Turned into an abstract compilation unit by Matthieu Sozeau, March 2006 *)
 
-open Errors
+open CErrors
 open Util
 open Names
 open Term
@@ -63,7 +63,7 @@ let apply_coercion_args env evd check isproj argl funj =
 	{ uj_val = applist (j_val funj,argl);
 	  uj_type = typ }
     | h::restl -> (* On devrait pouvoir s'arranger pour qu'on n'ait pas a faire hnf_constr *)
-      match kind_of_term (whd_betadeltaiota env evd typ) with
+      match kind_of_term (whd_all env evd typ) with
       | Prod (_,c1,c2) ->
         if check && not (e_cumul env evdref (Retyping.get_type_of env evd h) c1) then
 	  raise NoCoercion;
@@ -90,8 +90,9 @@ let inh_pattern_coerce_to loc env pat ind1 ind2 =
 
 open Program
 
-let make_existential loc ?(opaque = Evar_kinds.Define true) env evdref c =
-  Evarutil.e_new_evar env evdref ~src:(loc, Evar_kinds.QuestionMark opaque) c
+let make_existential loc ?(opaque = not (get_proofs_transparency ()))  env evdref c =
+  let src = (loc, Evar_kinds.QuestionMark (Evar_kinds.Define opaque)) in
+  Evarutil.e_new_evar env evdref ~src c
 
 let app_opt env evdref f t =
   whd_betaiota !evdref (app_opt f t)
@@ -115,7 +116,7 @@ let disc_subset x =
 
 exception NoSubtacCoercion
   
-let hnf env evd c = whd_betadeltaiota env evd c
+let hnf env evd c = whd_all env evd c
 let hnf_nodelta env evd c = whd_betaiota evd c
 
 let lift_args n sign =
@@ -152,7 +153,6 @@ and coerce loc env evdref (x : Term.constr) (y : Term.constr)
   and coerce' env x y : (Term.constr -> Term.constr) option =
     let subco () = subset_coerce env evdref x y in
     let dest_prod c =
-      let open Context.Rel.Declaration in
       match Reductionops.splay_prod_n env ( !evdref) 1 c with
       | [LocalAssum (na,t) | LocalDef (na,_,t)], c -> (na,t), c
       | _ -> raise NoSubtacCoercion
@@ -191,7 +191,7 @@ and coerce loc env evdref (x : Term.constr) (y : Term.constr)
 	  let term = co x in
 	    Typing.e_solve_evars env evdref term)
       in
-	if isEvar c || isEvar c' then
+	if isEvar c || isEvar c' || not (Program.is_program_generalized_coercion ()) then
 	  (* Second-order unification needed. *)
 	  raise NoSubtacCoercion;
 	aux [] typ typ' 0 (fun x -> x)
@@ -279,7 +279,7 @@ and coerce loc env evdref (x : Term.constr) (y : Term.constr)
 		     let c1 = coerce_unify env a a' in
 		     let c2 = coerce_unify env b b' in
 		       match c1, c2 with
-		       None, None -> None
+		       | None, None -> None
 		       | _, _ ->
 			   Some
 			     (fun x ->
@@ -369,11 +369,11 @@ let apply_coercion env sigma p hj typ_cl =
       (hj,typ_cl,sigma) p
     in evd, j
   with NoCoercion as e -> raise e
-  | e when Errors.noncritical e -> anomaly (Pp.str "apply_coercion")
+  | e when CErrors.noncritical e -> anomaly (Pp.str "apply_coercion")
 
 (* Try to coerce to a funclass; raise NoCoercion if not possible *)
 let inh_app_fun_core env evd j =
-  let t = whd_betadeltaiota env evd j.uj_type in
+  let t = whd_all env evd j.uj_type in
     match kind_of_term t with
     | Prod (_,_,_) -> (evd,j)
     | Evar ev ->
@@ -411,10 +411,10 @@ let inh_tosort_force loc env evd j =
     let j2 = on_judgment_type (whd_evar evd) j1 in
       (evd,type_judgment env j2)
   with Not_found | NoCoercion ->
-    error_not_a_type_loc loc env evd j
+    error_not_a_type ~loc env evd j
 
 let inh_coerce_to_sort loc env evd j =
-  let typ = whd_betadeltaiota env evd j.uj_type in
+  let typ = whd_all env evd j.uj_type in
     match kind_of_term typ with
     | Sort s -> (evd,{ utj_val = j.uj_val; utj_type = s })
     | Evar ev when not (is_defined evd (fst ev)) ->
@@ -466,8 +466,8 @@ let rec inh_conv_coerce_to_fail loc env evd rigidonly v t c1 =
     try inh_coerce_to_fail env evd rigidonly v t c1
     with NoCoercion ->
       match
-      kind_of_term (whd_betadeltaiota env evd t),
-      kind_of_term (whd_betadeltaiota env evd c1)
+      kind_of_term (whd_all env evd t),
+      kind_of_term (whd_all env evd c1)
       with
       | Prod (name,t1,t2), Prod (_,u1,u2) ->
           (* Conversion did not work, we may succeed with a coercion. *)
@@ -505,16 +505,16 @@ let inh_conv_coerce_to_gen resolve_tc rigidonly loc env evd cj t =
 	else raise NoSubtacCoercion
       with
       | NoSubtacCoercion when not resolve_tc || not !use_typeclasses_for_conversion ->
-	  error_actual_type_loc loc env best_failed_evd cj t e
+	  error_actual_type ~loc env best_failed_evd cj t e
       | NoSubtacCoercion ->
 	let evd' = saturate_evd env evd in
       	  try
 	    if evd' == evd then 
-	      error_actual_type_loc loc env best_failed_evd cj t e
+	      error_actual_type ~loc env best_failed_evd cj t e
 	    else 
       	      inh_conv_coerce_to_fail loc env evd' rigidonly (Some cj.uj_val) cj.uj_type t
-	  with NoCoercionNoUnifier (best_failed_evd,e) ->
-	    error_actual_type_loc loc env best_failed_evd cj t e
+	  with NoCoercionNoUnifier (_evd,_error) ->
+	    error_actual_type ~loc env best_failed_evd cj t e
   in
   let val' = match val' with Some v -> v | None -> assert(false) in
     (evd',{ uj_val = val'; uj_type = t })
diff --git a/pretyping/constr_matching.ml b/pretyping/constr_matching.ml
index 129725c6d..5ec44a68d 100644
--- a/pretyping/constr_matching.ml
+++ b/pretyping/constr_matching.ml
@@ -8,7 +8,7 @@
 
 (*i*)
 open Pp
-open Errors
+open CErrors
 open Util
 open Names
 open Globnames
@@ -45,16 +45,17 @@ open Context.Rel.Declaration
 
  *)
 
+type binding_bound_vars = Id.Set.t
 type bound_ident_map = Id.t Id.Map.t
 
 exception PatternMatchingFailure
 
-let warn_bound_meta name =
-  Feedback.msg_warning (str "Collision between bound variable " ++ pr_id name ++
-    str " and a metavariable of same name.")
+let warn_meta_collision =
+  CWarnings.create ~name:"meta-collision" ~category:"ltac"
+         (fun name ->
+          strbrk "Collision between bound variable " ++ pr_id name ++
+            strbrk " and a metavariable of same name.")
 
-let warn_bound_bound name =
-  Feedback.msg_warning (str "Collision between bound variables of name " ++ pr_id name)
 
 let constrain n (ids, m as x) (names, terms as subst) =
   try
@@ -62,18 +63,19 @@ let constrain n (ids, m as x) (names, terms as subst) =
     if List.equal Id.equal ids ids' && eq_constr m m' then subst
     else raise PatternMatchingFailure
   with Not_found ->
-    let () = if Id.Map.mem n names then warn_bound_meta n in
+    let () = if Id.Map.mem n names then warn_meta_collision n in
     (names, Id.Map.add n x terms)
 
 let add_binders na1 na2 binding_vars (names, terms as subst) =
   match na1, na2 with
   | Name id1, Name id2 when Id.Set.mem id1 binding_vars ->
     if Id.Map.mem id1 names then
-      let () = warn_bound_bound id1 in
+      let () = Glob_ops.warn_variable_collision id1 in
       (names, terms)
     else
       let names = Id.Map.add id1 id2 names in
-      let () = if Id.Map.mem id1 terms then warn_bound_meta id1 in
+      let () = if Id.Map.mem id1 terms then
+        warn_meta_collision id1 in
       (names, terms)
   | _ -> subst
 
diff --git a/pretyping/constr_matching.mli b/pretyping/constr_matching.mli
index 8d8166f22..ee6c5141b 100644
--- a/pretyping/constr_matching.mli
+++ b/pretyping/constr_matching.mli
@@ -13,6 +13,8 @@ open Term
 open Environ
 open Pattern
 
+type binding_bound_vars = Id.Set.t
+
 (** [PatternMatchingFailure] is the exception raised when pattern
   matching fails *)
 exception PatternMatchingFailure
@@ -41,7 +43,7 @@ val matches_head : env -> Evd.evar_map -> constr_pattern -> constr -> patvar_map
    variables or metavariables have the same name, the metavariable,
    or else the rightmost bound variable, takes precedence *)
 val extended_matches :
-  env -> Evd.evar_map -> Tacexpr.binding_bound_vars * constr_pattern ->
+  env -> Evd.evar_map -> binding_bound_vars * constr_pattern ->
   constr -> bound_ident_map * extended_patvar_map
 
 (** [is_matching pat c] just tells if [c] matches against [pat] *)
@@ -75,7 +77,7 @@ val match_appsubterm : env -> Evd.evar_map -> constr_pattern -> constr -> matchi
 (** [match_subterm_gen] calls either [match_subterm] or [match_appsubterm] *)
 val match_subterm_gen : env -> Evd.evar_map ->
   bool (** true = with app context *) ->
-  Tacexpr.binding_bound_vars * constr_pattern -> constr ->
+  binding_bound_vars * constr_pattern -> constr ->
   matching_result IStream.t
 
 (** [is_matching_appsubterm pat c] tells if a subterm of [c] matches
diff --git a/pretyping/detyping.ml b/pretyping/detyping.ml
index 86921c49b..cad5551c1 100644
--- a/pretyping/detyping.ml
+++ b/pretyping/detyping.ml
@@ -7,7 +7,7 @@
 (************************************************************************)
 
 open Pp
-open Errors
+open CErrors
 open Util
 open Names
 open Term
@@ -67,15 +67,15 @@ let isomorphic_to_tuple lc = Int.equal (Array.length lc) 1
 let encode_bool r =
   let (x,lc) = encode_inductive r in
   if not (has_two_constructors lc) then
-    user_err_loc (loc_of_reference r,"encode_if",
-      str "This type has not exactly two constructors.");
+    user_err ~loc:(loc_of_reference r) ~hdr:"encode_if"
+      (str "This type has not exactly two constructors.");
   x
 
 let encode_tuple r =
   let (x,lc) = encode_inductive r in
   if not (isomorphic_to_tuple lc) then
-    user_err_loc (loc_of_reference r,"encode_tuple",
-      str "This type cannot be seen as a tuple type.");
+    user_err ~loc:(loc_of_reference r) ~hdr:"encode_tuple"
+      (str "This type cannot be seen as a tuple type.");
   x
 
 module PrintingInductiveMake =
@@ -323,7 +323,7 @@ let is_nondep_branch c l =
     (* FIXME: do better using tags from l *)
     let sign,ccl = decompose_lam_n_decls (List.length l) c in
     noccur_between 1 (Context.Rel.length sign) ccl
-  with e when Errors.noncritical e -> (* Not eta-expanded or not reduced *)
+  with e when CErrors.noncritical e -> (* Not eta-expanded or not reduced *)
     false
 
 let extract_nondep_branches test c b l =
@@ -620,7 +620,7 @@ and share_names flags n l avoid env sigma c t =
         share_names flags (n-1) ((Name id,Explicit,None,t'')::l) avoid env sigma appc c'
     (* If built with the f/n notation: we renounce to share names *)
     | _ ->
-        if n>0 then Feedback.msg_warning (strbrk "Detyping.detype: cannot factorize fix enough");
+        if n>0 then Feedback.msg_debug (strbrk "Detyping.detype: cannot factorize fix enough");
         let c = detype flags avoid env sigma c in
         let t = detype flags avoid env sigma t in
         (List.rev l,c,t)
@@ -631,7 +631,7 @@ and detype_eqns flags avoid env sigma ci computable constructs consnargsl bl =
     let mat = build_tree Anonymous (snd flags) (avoid,env) ci bl in
     List.map (fun (pat,((avoid,env),c)) -> (dl,[],[pat],detype flags avoid env sigma c))
       mat
-  with e when Errors.noncritical e ->
+  with e when CErrors.noncritical e ->
     Array.to_list
       (Array.map3 (detype_eqn flags avoid env sigma) constructs consnargsl bl)
 
@@ -689,7 +689,7 @@ and detype_binder (lax,isgoal as flags) bk avoid env sigma na body ty c =
   | BLetIn ->
       let c = detype (lax,false) avoid env sigma (Option.get body) in
       (* Heuristic: we display the type if in Prop *)
-      let s = Retyping.get_sort_family_of (snd env) sigma ty in
+      let s = try Retyping.get_sort_family_of (snd env) sigma ty with _ when !Flags.in_debugger || !Flags.in_toplevel -> InType (* Can fail because of sigma missing in debugger *) in
       let c = if s != InProp then c else
           GCast (dl, c, CastConv (detype (lax,false) avoid env sigma ty)) in
       GLetIn (dl, na', c, r)
diff --git a/pretyping/evarconv.ml b/pretyping/evarconv.ml
index 89cb723bc..a2ffe12e9 100644
--- a/pretyping/evarconv.ml
+++ b/pretyping/evarconv.ml
@@ -6,12 +6,12 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-open Errors
+open CErrors
 open Util
 open Names
 open Term
 open Vars
-open Closure
+open CClosure
 open Reduction
 open Reductionops
 open Termops
@@ -24,7 +24,10 @@ open Globnames
 open Evd
 open Pretype_errors
 open Sigma.Notations
-open Context.Rel.Declaration
+open Context.Named.Declaration
+
+module RelDecl = Context.Rel.Declaration
+module NamedDecl = Context.Named.Declaration
 
 type unify_fun = transparent_state ->
   env -> evar_map -> conv_pb -> constr -> constr -> Evarsolve.unification_result
@@ -42,12 +45,7 @@ let _ = Goptions.declare_bool_option {
 let unfold_projection env evd ts p c =
   let cst = Projection.constant p in
     if is_transparent_constant ts cst then
-      let c' = Some (mkProj (Projection.make cst true, c)) in
-	match ReductionBehaviour.get (Globnames.ConstRef cst) with
-	| None -> c'
-	| Some (recargs, nargs, flags) ->
-	  if (List.mem `ReductionNeverUnfold flags) then None
-	  else c'
+      Some (mkProj (Projection.make cst true, c))
     else None
       
 let eval_flexible_term ts env evd c =
@@ -58,14 +56,13 @@ let eval_flexible_term ts env evd c =
       else None
   | Rel n ->
       (try match lookup_rel n env with
-           | LocalAssum _ -> None
-           | LocalDef (_,v,_) -> Some (lift n v)
+           | RelDecl.LocalAssum _ -> None
+           | RelDecl.LocalDef (_,v,_) -> Some (lift n v)
        with Not_found -> None)
   | Var id ->
       (try
 	 if is_transparent_variable ts id then
-           let open Context.Named.Declaration in
-	   lookup_named id env |> get_value
+	   env |> lookup_named id |> NamedDecl.get_value
 	 else None
        with Not_found -> None)
   | LetIn (_,b,_,c) -> Some (subst1 b c)
@@ -102,21 +99,20 @@ let position_problem l2r = function
   | CONV -> None
   | CUMUL -> Some l2r
 
-let occur_rigidly ev evd t = 
-  let (l, app) = decompose_app_vect t in 
-  let rec aux t = 
+let occur_rigidly (evk,_ as ev) evd t =
+  let rec aux t =
     match kind_of_term (whd_evar evd t) with
     | App (f, c) -> if aux f then Array.exists aux c else false
     | Construct _ | Ind _ | Sort _ | Meta _ | Fix _ | CoFix _ -> true
     | Proj (p, c) -> not (aux c)
-    | Evar (ev',_) -> if Evar.equal ev ev' then raise Occur else false
+    | Evar (evk',_) -> if Evar.equal evk evk' then raise Occur else false
     | Cast (p, _, _) -> aux p
     | Lambda _ | LetIn _ -> false
     | Const _ -> false
     | Prod (_, b, t) -> ignore(aux b || aux t); true
     | Rel _ | Var _ -> false
-    | Case _ -> false
-  in Array.exists (fun t -> try ignore(aux t); false with Occur -> true) app
+    | Case (_,_,c,_) -> if eq_constr (mkEvar ev) c then raise Occur else false
+  in try ignore(aux t); false with Occur -> true
 
 (* [check_conv_record env sigma (t1,stack1) (t2,stack2)] tries to decompose 
    the problem (t1 stack1) = (t2 stack2) into a problem
@@ -315,7 +311,7 @@ let exact_ise_stack2 env evd f sk1 sk2 =
   if Reductionops.Stack.compare_shape sk1 sk2 then
     ise_stack2 evd (List.rev sk1) (List.rev sk2)
   else UnifFailure (evd, (* Dummy *) NotSameHead)
-    
+
 let rec evar_conv_x ts env evd pbty term1 term2 =
   let term1 = whd_head_evar evd term1 in
   let term2 = whd_head_evar evd term2 in
@@ -368,8 +364,6 @@ let rec evar_conv_x ts env evd pbty term1 term2 =
 
 and evar_eqappr_x ?(rhs_is_already_stuck = false) ts env evd pbty
     ((term1,sk1 as appr1),csts1) ((term2,sk2 as appr2),csts2) =
-  let default_fail i = (* costly *)
-    UnifFailure (i,ConversionFailed (env, Stack.zip appr1, Stack.zip appr2)) in
   let quick_fail i = (* not costly, loses info *)
     UnifFailure (i, NotSameHead)
   in
@@ -397,7 +391,7 @@ and evar_eqappr_x ?(rhs_is_already_stuck = false) ts env evd pbty
     assert (match sk with [] -> true | _ -> false);
     let (na,c1,c'1) = destLambda term in
     let c = nf_evar evd c1 in
-    let env' = push_rel (LocalAssum (na,c)) env in
+    let env' = push_rel (RelDecl.LocalAssum (na,c)) env in
     let out1 = whd_betaiota_deltazeta_for_iota_state
       (fst ts) env' evd Cst_stack.empty (c'1, Stack.empty) in
     let out2 = whd_nored_state evd
@@ -407,21 +401,23 @@ and evar_eqappr_x ?(rhs_is_already_stuck = false) ts env evd pbty
     else evar_eqappr_x ts env' evd CONV out2 out1
   in
   let rigids env evd sk term sk' term' =
-    let b,univs = Universes.eq_constr_universes term term' in
-      if b then
+    let univs = Universes.eq_constr_universes term term' in
+    match univs with
+    | Some univs ->
        ise_and evd [(fun i ->
          let cstrs = Universes.to_constraints (Evd.universes i) univs in
            try Success (Evd.add_constraints i cstrs)
            with Univ.UniverseInconsistency p -> UnifFailure (i, UnifUnivInconsistency p));
                   (fun i -> exact_ise_stack2 env i (evar_conv_x ts) sk sk')]
-      else UnifFailure (evd,NotSameHead)
+    | None ->
+      UnifFailure (evd,NotSameHead)
   in
   let flex_maybeflex on_left ev ((termF,skF as apprF),cstsF) ((termM, skM as apprM),cstsM) vM =
     let switch f a b = if on_left then f a b else f b a in
     let not_only_app = Stack.not_purely_applicative skM in
     let f1 i =
       match Stack.list_of_app_stack skF with
-      | None -> default_fail evd
+      | None -> quick_fail evd
       | Some lF -> 
         let tM = Stack.zip apprM in
 	  miller_pfenning on_left
@@ -435,7 +431,8 @@ and evar_eqappr_x ?(rhs_is_already_stuck = false) ts env evd pbty
       else quick_fail i
     and delta i =
       switch (evar_eqappr_x ts env i pbty) (apprF,cstsF)
-	(whd_betaiota_deltazeta_for_iota_state (fst ts) env i cstsM (vM,skM))
+	     (whd_betaiota_deltazeta_for_iota_state
+  	        (fst ts) env i cstsM (vM,skM))
     in    
     let default i = ise_try i [f1; consume apprF apprM; delta]
     in
@@ -452,7 +449,8 @@ and evar_eqappr_x ?(rhs_is_already_stuck = false) ts env evd pbty
 		try 
 		  let termM' = Retyping.expand_projection env evd p c [] in
 		  let apprM', cstsM' = 
-		    whd_betaiota_deltazeta_for_iota_state (fst ts) env evd cstsM (termM',skM)
+		    whd_betaiota_deltazeta_for_iota_state
+		      (fst ts) env evd cstsM (termM',skM)
 		  in
 		  let delta' i = 
 		    switch (evar_eqappr_x ts env i pbty) (apprF,cstsF) (apprM',cstsM') 
@@ -468,10 +466,11 @@ and evar_eqappr_x ?(rhs_is_already_stuck = false) ts env evd pbty
   let flex_rigid on_left ev (termF, skF as apprF) (termR, skR as apprR) =
     let switch f a b = if on_left then f a b else f b a in
     let eta evd =
-             match kind_of_term termR with
-	     | Lambda _ -> eta env evd false skR termR skF termF
-	     | Construct u -> eta_constructor ts env evd skR u skF termF
-	     | _ -> UnifFailure (evd,NotSameHead)
+      match kind_of_term termR with
+      | Lambda _ when (* if ever problem is ill-typed: *) List.is_empty skR ->
+         eta env evd false skR termR skF termF
+      | Construct u -> eta_constructor ts env evd skR u skF termF
+      | _ -> UnifFailure (evd,NotSameHead)
     in
     match Stack.list_of_app_stack skF with
     | None ->
@@ -483,7 +482,7 @@ and evar_eqappr_x ?(rhs_is_already_stuck = false) ts env evd pbty
 	      ise_try evd 
 	        [eta;(* Postpone the use of an heuristic *)
 		 (fun i -> 
-		   if not (occur_rigidly (fst ev) i tR) then
+		   if not (occur_rigidly ev i tR) then
                      let i,tF =
                        if isRel tR || isVar tR then
                          (* Optimization so as to generate candidates *)
@@ -506,10 +505,13 @@ and evar_eqappr_x ?(rhs_is_already_stuck = false) ts env evd pbty
   match (flex_kind_of_term (fst ts) env evd term1 sk1, 
 	 flex_kind_of_term (fst ts) env evd term2 sk2) with
     | Flexible (sp1,al1 as ev1), Flexible (sp2,al2 as ev2) ->
+        (* sk1[?ev1] =? sk2[?ev2] *)
 	let f1 i =
+          (* Try first-order unification *)
 	  match ise_stack2 false env i (evar_conv_x ts) sk1 sk2 with
-	  |None, Success i' -> 
-	    (* Evar can be defined in i' *)
+	  | None, Success i' ->
+            (* We do have sk1[] = sk2[]: we now unify ?ev1 and ?ev2 *)
+            (* Note that ?ev1 and ?ev2, may have been instantiated in the meantime *)
 	    let ev1' = whd_evar i' (mkEvar ev1) in
 	      if isEvar ev1' then
 		solve_simple_eqn (evar_conv_x ts) env i'
@@ -517,7 +519,9 @@ and evar_eqappr_x ?(rhs_is_already_stuck = false) ts env evd pbty
 	      else 
 		evar_eqappr_x ts env evd pbty 
 		  ((ev1', sk1), csts1) ((term2, sk2), csts2)
-	  |Some (r,[]), Success i' -> 
+	  | Some (r,[]), Success i' ->
+            (* We have sk1'[] = sk2[] for some sk1' s.t. sk1[]=sk1'[r[]] *)
+            (* we now unify r[?ev1] and ?ev2 *)
 	    let ev2' = whd_evar i' (mkEvar ev2) in
 	      if isEvar ev2' then
 		solve_simple_eqn (evar_conv_x ts) env i'
@@ -525,16 +529,46 @@ and evar_eqappr_x ?(rhs_is_already_stuck = false) ts env evd pbty
 	      else 
 		evar_eqappr_x ts env evd pbty 
 		  ((ev2', sk1), csts1) ((term2, sk2), csts2)
-
-	  |Some ([],r), Success i' -> 
+	  | Some ([],r), Success i' ->
+            (* Symmetrically *)
+            (* We have sk1[] = sk2'[] for some sk2' s.t. sk2[]=sk2'[r[]] *)
+            (* we now unify ?ev1 and r[?ev2] *)
 	    let ev1' = whd_evar i' (mkEvar ev1) in
 	      if isEvar ev1' then
 		solve_simple_eqn (evar_conv_x ts) env i'
 	          (position_problem true pbty,destEvar ev1',Stack.zip(term2,r))
 	      else evar_eqappr_x ts env evd pbty 
 		((ev1', sk1), csts1) ((term2, sk2), csts2)
-	  |_, (UnifFailure _ as x) -> x
-	  |Some _, _ -> UnifFailure (i,NotSameArgSize)
+	  | None, (UnifFailure _ as x) ->
+             (* sk1 and sk2 have no common outer part *)
+             if Stack.not_purely_applicative sk2 then
+               (* Ad hoc compatibility with 8.4 which treated non-app as rigid *)
+               flex_rigid true ev1 appr1 appr2
+             else
+             if Stack.not_purely_applicative sk1 then
+               (* Ad hoc compatibility with 8.4 which treated non-app as rigid *)
+               flex_rigid false ev2 appr2 appr1
+             else
+               (* We could instead try Miller unification, then
+                  postpone to see if other equations help, as in:
+                  [Check fun a b : unit => (eqᵣefl : _ a = _ a b)] *)
+               x
+	  | Some _, Success _ ->
+             (* sk1 and sk2 have a common outer part *)
+             if Stack.not_purely_applicative sk2 then
+               (* Ad hoc compatibility with 8.4 which treated non-app as rigid *)
+               flex_rigid true ev1 appr1 appr2
+             else
+             if Stack.not_purely_applicative sk1 then
+               (* Ad hoc compatibility with 8.4 which treated non-app as rigid *)
+               flex_rigid false ev2 appr2 appr1
+             else
+               (* We could instead try Miller unification, then
+                  postpone to see if other equations help, as in:
+                  [Check fun a b c : unit => (eqᵣefl : _ a b = _ c a b)] *)
+               UnifFailure (i,NotSameArgSize)
+          | _, _ -> anomaly (Pp.str "Unexpected result from ise_stack2.")
+
 	and f2 i =
           if Evar.equal sp1 sp2 then
 	    match ise_stack2 false env i (evar_conv_x ts) sk1 sk2 with
@@ -557,14 +591,17 @@ and evar_eqappr_x ?(rhs_is_already_stuck = false) ts env evd pbty
     | MaybeFlexible v1, MaybeFlexible v2 -> begin
         match kind_of_term term1, kind_of_term term2 with
         | LetIn (na1,b1,t1,c'1), LetIn (na2,b2,t2,c'2) ->
-        let f1 i =
+        let f1 i = (* FO *)
           ise_and i
-	    [(fun i -> evar_conv_x ts env i CONV b1 b2);
+            [(fun i -> ise_try i
+               [(fun i -> evar_conv_x ts env i CUMUL t1 t2);
+                (fun i -> evar_conv_x ts env i CUMUL t2 t1)]);
+             (fun i -> evar_conv_x ts env i CONV b1 b2);
 	     (fun i ->
 	       let b = nf_evar i b1 in
 	       let t = nf_evar i t1 in
                let na = Nameops.name_max na1 na2 in
-	       evar_conv_x ts (push_rel (LocalDef (na,b,t)) env) i pbty c'1 c'2);
+	       evar_conv_x ts (push_rel (RelDecl.LocalDef (na,b,t)) env) i pbty c'1 c'2);
 	     (fun i -> exact_ise_stack2 env i (evar_conv_x ts) sk1 sk2)]
 	and f2 i =
           let out1 = whd_betaiota_deltazeta_for_iota_state (fst ts) env i csts1 (v1,sk1)
@@ -615,14 +652,16 @@ and evar_eqappr_x ?(rhs_is_already_stuck = false) ts env evd pbty
 	     allow this identification (first-order unification of universes). Otherwise
 	     fallback to unfolding.
 	  *)
-	  let b,univs = Universes.eq_constr_universes term1 term2 in
-	    if b then
+	  let univs = Universes.eq_constr_universes term1 term2 in
+          match univs with
+          | Some univs ->
 	      ise_and i [(fun i -> 
 		try Success (Evd.add_universe_constraints i univs)
 		with UniversesDiffer -> UnifFailure (i,NotSameHead)
 		| Univ.UniverseInconsistency p -> UnifFailure (i, UnifUnivInconsistency p));
 			 (fun i -> exact_ise_stack2 env i (evar_conv_x ts) sk1 sk2)]
-	    else UnifFailure (i,NotSameHead)
+          | None ->
+            UnifFailure (i,NotSameHead)
 	and f2 i =
 	  (try 
 	     if not (snd ts) then raise Not_found
@@ -679,7 +718,7 @@ and evar_eqappr_x ?(rhs_is_already_stuck = false) ts env evd pbty
            (fun i ->
 	     let c = nf_evar i c1 in
              let na = Nameops.name_max na1 na2 in
-	     evar_conv_x ts (push_rel (LocalAssum (na,c)) env) i CONV c'1 c'2)]
+	     evar_conv_x ts (push_rel (RelDecl.LocalAssum (na,c)) env) i CONV c'1 c'2)]
 
     | Flexible ev1, Rigid -> flex_rigid true ev1 appr1 appr2
     | Rigid, Flexible ev2 -> flex_rigid false ev2 appr2 appr1
@@ -712,10 +751,10 @@ and evar_eqappr_x ?(rhs_is_already_stuck = false) ts env evd pbty
 	  ise_try evd [f3; f4]
 
     (* Eta-expansion *)
-    | Rigid, _ when isLambda term1 ->
+    | Rigid, _ when isLambda term1 && (* if ever ill-typed: *) List.is_empty sk1 ->
         eta env evd true sk1 term1 sk2 term2
 
-    | _, Rigid when isLambda term2 ->
+    | _, Rigid when isLambda term2 && (* if ever ill-typed: *) List.is_empty sk2 ->
         eta env evd false sk2 term2 sk1 term1
 
     | Rigid, Rigid -> begin
@@ -730,7 +769,7 @@ and evar_eqappr_x ?(rhs_is_already_stuck = false) ts env evd pbty
 	       in Success evd'
 	     with Univ.UniverseInconsistency p ->
                UnifFailure (evd,UnifUnivInconsistency p)
-	     | e when Errors.noncritical e -> UnifFailure (evd,NotSameHead))
+	     | e when CErrors.noncritical e -> UnifFailure (evd,NotSameHead))
 
 	| Prod (n1,c1,c'1), Prod (n2,c2,c'2) when app_empty ->
             ise_and evd
@@ -738,7 +777,7 @@ and evar_eqappr_x ?(rhs_is_already_stuck = false) ts env evd pbty
                (fun i ->
  	         let c = nf_evar i c1 in
                  let na = Nameops.name_max n1 n2 in
-	         evar_conv_x ts (push_rel (LocalAssum (na,c)) env) i pbty c'1 c'2)]
+	         evar_conv_x ts (push_rel (RelDecl.LocalAssum (na,c)) env) i pbty c'1 c'2)]
 
 	| Rel x1, Rel x2 ->
 	    if Int.equal x1 x2 then
@@ -915,7 +954,6 @@ let choose_less_dependent_instance evk evd term args =
   | [] -> None
   | (id, _) :: _ -> Some (Evd.define evk (mkVar id) evd)
 
-open Context.Named.Declaration
 let apply_on_subterm env evdref f c t =
   let rec applyrec (env,(k,c) as acc) t =
     (* By using eq_constr, we make an approximation, for instance, we *)
@@ -946,14 +984,16 @@ let filter_possible_projections c ty ctxt args =
   List.map_i (fun i decl ->
     let () = assert (i < len) in
     let a = Array.unsafe_get args i in
-    (match decl with LocalAssum _ -> false | LocalDef (_,c,_) -> not (isRel c || isVar c)) ||
+    (match decl with
+     | NamedDecl.LocalAssum _ -> false
+     | NamedDecl.LocalDef (_,c,_) -> not (isRel c || isVar c)) ||
     a == c ||
     (* Here we make an approximation, for instance, we could also be *)
     (* interested in finding a term u convertible to c such that a occurs *)
     (* in u *)
     isRel a && Int.Set.mem (destRel a) fv1 ||
     isVar a && Id.Set.mem (destVar a) fv2 ||
-    Id.Set.mem (get_id decl) tyvars)
+    Id.Set.mem (NamedDecl.get_id decl) tyvars)
     0 ctxt
 
 let solve_evars = ref (fun _ -> failwith "solve_evars not installed")
@@ -984,10 +1024,10 @@ let second_order_matching ts env_rhs evd (evk,args) argoccs rhs =
   let env_evar = evar_filtered_env evi in
   let sign = named_context_val env_evar in
   let ctxt = evar_filtered_context evi in
-  let instance = List.map mkVar (List.map get_id ctxt) in
+  let instance = List.map mkVar (List.map NamedDecl.get_id ctxt) in
 
   let rec make_subst = function
-  | decl'::ctxt', c::l, occs::occsl when isVarId (get_id decl') c ->
+  | decl'::ctxt', c::l, occs::occsl when isVarId (NamedDecl.get_id decl') c ->
       begin match occs with
       | Some _ ->
         error "Cannot force abstraction on identity instance."
@@ -995,7 +1035,8 @@ let second_order_matching ts env_rhs evd (evk,args) argoccs rhs =
         make_subst (ctxt',l,occsl)
       end
   | decl'::ctxt', c::l, occs::occsl ->
-      let (id,_,t) = to_tuple decl' in
+      let id = NamedDecl.get_id decl' in
+      let t = NamedDecl.get_type decl' in
       let evs = ref [] in
       let ty = Retyping.get_type_of env_rhs evd c in
       let filter' = filter_possible_projections c ty ctxt args in
@@ -1048,7 +1089,7 @@ let second_order_matching ts env_rhs evd (evk,args) argoccs rhs =
               match evar_conv_x ts env_evar evd CUMUL idty evty with
               | UnifFailure _ -> error "Cannot find an instance"
               | Success evd ->
-              match reconsider_conv_pbs (evar_conv_x ts) evd with
+              match reconsider_unif_constraints (evar_conv_x ts) evd with
               | UnifFailure _ -> error "Cannot find an instance"
               | Success evd ->
               evd
@@ -1071,7 +1112,7 @@ let second_order_matching ts env_rhs evd (evk,args) argoccs rhs =
   abstract_free_holes evd subst, true
   with TypingFailed evd -> evd, false
 
-let second_order_matching_with_args ts env evd ev l t =
+let second_order_matching_with_args ts env evd pbty ev l t =
 (*
   let evd,ev = evar_absorb_arguments env evd ev l in
   let argoccs = Array.map_to_list (fun _ -> None) (snd ev) in
@@ -1079,8 +1120,9 @@ let second_order_matching_with_args ts env evd ev l t =
   if b then Success evd
   else UnifFailure (evd, ConversionFailed (env,mkApp(mkEvar ev,l),t))
   if b then Success evd else
-*)
-  UnifFailure (evd, ConversionFailed (env,mkApp(mkEvar ev,l),t))
+ *)
+  let pb = (pbty,env,mkApp(mkEvar ev,l),t) in
+  UnifFailure (evd, CannotSolveConstraint (pb,ProblemBeyondCapabilities))
 
 let apply_conversion_problem_heuristic ts env evd pbty t1 t2 =
   let t1 = apprec_nohdbeta ts env evd (whd_head_evar evd t1) in
@@ -1096,7 +1138,9 @@ let apply_conversion_problem_heuristic ts env evd pbty t1 t2 =
          type inference *)
       (match choose_less_dependent_instance evk1 evd term2 args1 with
       | Some evd -> Success evd
-      | None -> UnifFailure (evd, ConversionFailed (env,term1,term2)))
+      | None ->
+         let reason = ProblemBeyondCapabilities in
+         UnifFailure (evd, CannotSolveConstraint ((pbty,env,t1,t2),reason)))
   | (Rel _|Var _), Evar (evk2,args2) when app_empty
       && List.for_all (fun a -> Term.eq_constr a term1 || isEvar a)
         (remove_instance_local_defs evd evk2 args2) ->
@@ -1104,12 +1148,14 @@ let apply_conversion_problem_heuristic ts env evd pbty t1 t2 =
          type inference *)
       (match choose_less_dependent_instance evk2 evd term1 args2 with
       | Some evd -> Success evd
-      | None -> UnifFailure (evd, ConversionFailed (env,term1,term2)))
+      | None ->
+         let reason = ProblemBeyondCapabilities in
+         UnifFailure (evd, CannotSolveConstraint ((pbty,env,t1,t2),reason)))
   | Evar (evk1,args1), Evar (evk2,args2) when Evar.equal evk1 evk2 ->
       let f env evd pbty x y = is_fconv ~reds:ts pbty env evd x y in
       Success (solve_refl ~can_drop:true f env evd
                  (position_problem true pbty) evk1 args1 args2)
-  | Evar ev1, Evar ev2 ->
+  | Evar ev1, Evar ev2 when app_empty ->
       Success (solve_evar_evar ~force:true
         (evar_define (evar_conv_x ts) ~choose:true) (evar_conv_x ts) env evd
         (position_problem true pbty) ev1 ev2)
@@ -1119,27 +1165,32 @@ let apply_conversion_problem_heuristic ts env evd pbty t1 t2 =
       ise_try evd
         [(fun evd -> first_order_unification ts env evd (ev1,l1) appr2);
          (fun evd ->
-           second_order_matching_with_args ts env evd ev1 l1 t2)]
+           second_order_matching_with_args ts env evd pbty ev1 l1 t2)]
   | _,Evar ev2 when Array.length l2 <= Array.length l1 ->
       (* On "u u1 .. u(n+p) = ?n t1 .. tn", try first-order unification *)
       (* and otherwise second-order matching *)
       ise_try evd
         [(fun evd -> first_order_unification ts env evd (ev2,l2) appr1);
          (fun evd ->
-           second_order_matching_with_args ts env evd ev2 l2 t1)]
+           second_order_matching_with_args ts env evd pbty ev2 l2 t1)]
   | Evar ev1,_ ->
       (* Try second-order pattern-matching *)
-      second_order_matching_with_args ts env evd ev1 l1 t2
+      second_order_matching_with_args ts env evd pbty ev1 l1 t2
   | _,Evar ev2 ->
       (* Try second-order pattern-matching *)
-      second_order_matching_with_args ts env evd ev2 l2 t1
+      second_order_matching_with_args ts env evd pbty ev2 l2 t1
   | _ ->
       (* Some head evar have been instantiated, or unknown kind of problem *)
       evar_conv_x ts env evd pbty t1 t2
 
+let error_cannot_unify env evd pb ?reason t1 t2 =
+  Pretype_errors.error_cannot_unify
+    ~loc:(loc_of_conv_pb evd pb) env
+    evd ?reason (t1, t2)
+
 let check_problems_are_solved env evd =
   match snd (extract_all_conv_pbs evd) with
-  | (pbty,env,t1,t2)::_ -> Pretype_errors.error_cannot_unify env evd (t1, t2)
+  | (pbty,env,t1,t2) as pb::_ -> error_cannot_unify env evd pb t1 t2
   | _ -> ()
 
 let max_undefined_with_candidates evd =
@@ -1170,7 +1221,7 @@ let rec solve_unconstrained_evars_with_candidates ts evd =
             let conv_algo = evar_conv_x ts in
             let evd = check_evar_instance evd evk a conv_algo in
             let evd = Evd.define evk a evd in
-            match reconsider_conv_pbs conv_algo evd with
+            match reconsider_unif_constraints conv_algo evd with
             | Success evd -> solve_unconstrained_evars_with_candidates ts evd
             | UnifFailure _ -> aux l
           with
@@ -1184,16 +1235,16 @@ let rec solve_unconstrained_evars_with_candidates ts evd =
 let solve_unconstrained_impossible_cases env evd =
   Evd.fold_undefined (fun evk ev_info evd' ->
     match ev_info.evar_source with
-    | _,Evar_kinds.ImpossibleCase -> 
+    | loc,Evar_kinds.ImpossibleCase ->
       let j, ctx = coq_unit_judge () in
-      let evd' = Evd.merge_context_set Evd.univ_flexible_alg evd' ctx in
+      let evd' = Evd.merge_context_set Evd.univ_flexible_alg ~loc evd' ctx in
       let ty = j_type j in
       let conv_algo = evar_conv_x full_transparent_state in
       let evd' = check_evar_instance evd' evk ty conv_algo in
 	Evd.define evk ty evd' 
     | _ -> evd') evd evd
 
-let consider_remaining_unif_problems env
+let solve_unif_constraints_with_heuristics env
     ?(ts=Conv_oracle.get_transp_state (Environ.oracle env)) evd =
   let evd = solve_unconstrained_evars_with_candidates ts evd in
   let rec aux evd pbs progress stuck =
@@ -1208,23 +1259,23 @@ let consider_remaining_unif_problems env
 	      aux evd pbs progress (pb :: stuck)
             end
         | UnifFailure (evd,reason) ->
-	    Pretype_errors.error_cannot_unify_loc (loc_of_conv_pb evd pb)
-              env evd ~reason (t1, t2))
+           error_cannot_unify env evd pb ~reason t1 t2)
     | _ -> 
 	if progress then aux evd stuck false []
 	else 
 	  match stuck with
 	  | [] -> (* We're finished *) evd
 	  | (pbty,env,t1,t2 as pb) :: _ ->
-	      (* There remains stuck problems *)
-	      Pretype_errors.error_cannot_unify_loc (loc_of_conv_pb evd pb)
-                env evd (t1, t2)
+	     (* There remains stuck problems *)
+             error_cannot_unify env evd pb t1 t2
   in
   let (evd,pbs) = extract_all_conv_pbs evd in
   let heuristic_solved_evd = aux evd pbs false [] in
   check_problems_are_solved env heuristic_solved_evd;
   solve_unconstrained_impossible_cases env heuristic_solved_evd
 
+let consider_remaining_unif_problems = solve_unif_constraints_with_heuristics
+
 (* Main entry points *)
 
 exception UnableToUnify of evar_map * unification_error
diff --git a/pretyping/evarconv.mli b/pretyping/evarconv.mli
index 14947c892..2231e5bc3 100644
--- a/pretyping/evarconv.mli
+++ b/pretyping/evarconv.mli
@@ -33,7 +33,10 @@ val e_cumul : env -> ?ts:transparent_state -> evar_map ref -> constr -> constr -
 (** Try heuristics to solve pending unification problems and to solve
     evars with candidates *)
 
+val solve_unif_constraints_with_heuristics : env -> ?ts:transparent_state -> evar_map -> evar_map
+
 val consider_remaining_unif_problems : env -> ?ts:transparent_state -> evar_map -> evar_map
+(** @deprecated Alias for [solve_unif_constraints_with_heuristics] *)
 
 (** Check all pending unification problems are solved and raise an
     error otherwise *)
diff --git a/pretyping/evardefine.ml b/pretyping/evardefine.ml
index d349cf821..06f619410 100644
--- a/pretyping/evardefine.ml
+++ b/pretyping/evardefine.ml
@@ -19,21 +19,21 @@ open Evarutil
 open Pretype_errors
 open Sigma.Notations
 
+module RelDecl = Context.Rel.Declaration
+
 let new_evar_unsafe env evd ?src ?filter ?candidates ?store ?naming ?principal typ =
   let evd = Sigma.Unsafe.of_evar_map evd in
   let Sigma (evk, evd, _) = new_evar env evd ?src ?filter ?candidates ?store ?naming ?principal typ in
   (Sigma.to_evar_map evd, evk)
 
 let env_nf_evar sigma env =
-  let open Context.Rel.Declaration in
   process_rel_context
-    (fun d e -> push_rel (map_constr (nf_evar sigma) d) e) env
+    (fun d e -> push_rel (RelDecl.map_constr (nf_evar sigma) d) e) env
 
 let env_nf_betaiotaevar sigma env =
-  let open Context.Rel.Declaration in
   process_rel_context
     (fun d e ->
-      push_rel (map_constr (Reductionops.nf_betaiota sigma) d) e) env
+      push_rel (RelDecl.map_constr (Reductionops.nf_betaiota sigma) d) e) env
 
 (****************************************)
 (* Operations on value/type constraints *)
@@ -78,7 +78,7 @@ let define_pure_evar_as_product evd evk =
   let evi = Evd.find_undefined evd evk in
   let evenv = evar_env evi in
   let id = next_ident_away idx (ids_of_named_context (evar_context evi)) in
-  let concl = Reductionops.whd_betadeltaiota evenv evd evi.evar_concl in
+  let concl = Reductionops.whd_all evenv evd evi.evar_concl in
   let s = destSort concl in
   let evd1,(dom,u1) =
     let evd = Sigma.Unsafe.of_evar_map evd in
@@ -131,11 +131,11 @@ let define_pure_evar_as_lambda env evd evk =
   let open Context.Named.Declaration in
   let evi = Evd.find_undefined evd evk in
   let evenv = evar_env evi in
-  let typ = Reductionops.whd_betadeltaiota evenv evd (evar_concl evi) in
+  let typ = Reductionops.whd_all evenv evd (evar_concl evi) in
   let evd1,(na,dom,rng) = match kind_of_term typ with
   | Prod (na,dom,rng) -> (evd,(na,dom,rng))
   | Evar ev' -> let evd,typ = define_evar_as_product evd ev' in evd,destProd typ
-  | _ -> error_not_product_loc Loc.ghost env evd typ in
+  | _ -> error_not_product env evd typ in
   let avoid = ids_of_named_context (evar_context evi) in
   let id =
     next_name_away_with_default_using_types "x" na avoid (Reductionops.whd_evar evd dom) in
@@ -169,7 +169,7 @@ let define_evar_as_sort env evd (ev,args) =
   let evd, u = new_univ_variable univ_rigid evd in
   let evi = Evd.find_undefined evd ev in 
   let s = Type u in
-  let concl = Reductionops.whd_betadeltaiota (evar_env evi) evd evi.evar_concl in
+  let concl = Reductionops.whd_all (evar_env evi) evd evi.evar_concl in
   let sort = destSort concl in
   let evd' = Evd.define ev (mkSort s) evd in
   Evd.set_leq_sort env evd' (Type (Univ.super u)) sort, s
@@ -181,17 +181,17 @@ let define_evar_as_sort env evd (ev,args) =
 
 let split_tycon loc env evd tycon =
   let rec real_split evd c =
-    let t = Reductionops.whd_betadeltaiota env evd c in
+    let t = Reductionops.whd_all env evd c in
       match kind_of_term t with
 	| Prod (na,dom,rng) -> evd, (na, dom, rng)
-	| Evar ev (* ev is undefined because of whd_betadeltaiota *) ->
+	| Evar ev (* ev is undefined because of whd_all *) ->
 	    let (evd',prod) = define_evar_as_product evd ev in
 	    let (_,dom,rng) = destProd prod in
 	      evd',(Anonymous, dom, rng)
 	| App (c,args) when isEvar c ->
 	    let (evd',lam) = define_evar_as_lambda env evd (destEvar c) in
 	    real_split evd' (mkApp (lam,args))
-	| _ -> error_not_product_loc loc env evd c
+	| _ -> error_not_product ~loc env evd c
   in
     match tycon with
       | None -> evd,(Anonymous,None,None)
diff --git a/pretyping/evarsolve.ml b/pretyping/evarsolve.ml
index 455a7dbd6..92662f07d 100644
--- a/pretyping/evarsolve.ml
+++ b/pretyping/evarsolve.ml
@@ -7,7 +7,7 @@
 (************************************************************************)
 
 open Util
-open Errors
+open CErrors
 open Names
 open Term
 open Vars
@@ -42,28 +42,39 @@ let get_polymorphic_positions f =
         templ.template_param_levels)
   | _ -> assert false
 
-let refresh_level evd s =
-  match Evd.is_sort_variable evd s with
-  | None -> true
-  | Some l -> not (Evd.is_flexible_level evd l)
-
-let refresh_universes ?(status=univ_rigid) ?(onlyalg=false) pbty env evd t =
+let refresh_universes ?(status=univ_rigid) ?(onlyalg=false) ?(refreshset=false)
+		      pbty env evd t =
   let evdref = ref evd in
   let modified = ref false in
-  let rec refresh status dir t = 
-    match kind_of_term t with
-    | Sort (Type u as s) when
-      (match Univ.universe_level u with
-      | None -> true
-      | Some l -> not onlyalg && refresh_level evd s) ->
+  (* direction: true for fresh universes lower than the existing ones *)
+  let refresh_sort status ~direction s =
     let s' = evd_comb0 (new_sort_variable status) evdref in
     let evd = 
-      if dir then set_leq_sort env !evdref s' s
+      if direction then set_leq_sort env !evdref s' s
       else set_leq_sort env !evdref s s'
     in
-      modified := true; evdref := evd; mkSort s'
+    modified := true; evdref := evd; mkSort s'
+  in
+  let rec refresh ~onlyalg status ~direction t =
+    match kind_of_term t with
+    | Sort (Type u as s) ->
+       (match Univ.universe_level u with
+	| None -> refresh_sort status ~direction s
+	| Some l ->
+	   (match Evd.universe_rigidity evd l with
+	    | UnivRigid ->
+	       if not onlyalg then refresh_sort status ~direction s
+	       else t
+	    | UnivFlexible alg ->
+	       if onlyalg && alg then
+	         (evdref := Evd.make_flexible_variable !evdref false l; t)
+	       else t))
+    | Sort (Prop Pos as s) when refreshset && not direction ->
+       (* Cannot make a universe "lower" than "Set",
+          only refreshing when we want higher universes. *)
+       refresh_sort status ~direction s
     | Prod (na,u,v) -> 
-      mkProd (na,u,refresh status dir v)
+      mkProd (na, u, refresh ~onlyalg status ~direction v)
     | _ -> t
   (** Refresh the types of evars under template polymorphic references *)
   and refresh_term_evars onevars top t =
@@ -76,7 +87,7 @@ let refresh_universes ?(status=univ_rigid) ?(onlyalg=false) pbty env evd t =
       Array.iter (refresh_term_evars onevars false) args
     | Evar (ev, a) when onevars ->
       let evi = Evd.find !evdref ev in
-      let ty' = refresh univ_flexible true evi.evar_concl in
+      let ty' = refresh ~onlyalg univ_flexible ~direction:true evi.evar_concl in
 	if !modified then 
 	  evdref := Evd.add !evdref ev {evi with evar_concl = ty'}
 	else ()
@@ -96,9 +107,11 @@ let refresh_universes ?(status=univ_rigid) ?(onlyalg=false) pbty env evd t =
   in
   let t' = 
     if isArity t then
-      (match pbty with
-      | None -> t
-      | Some dir -> refresh status dir t)
+      match pbty with
+      | None ->
+	 (* No cumulativity needed, but we still need to refresh the algebraics *)
+	 refresh ~onlyalg:true univ_flexible ~direction:false t
+      | Some direction -> refresh ~onlyalg status ~direction t
     else (refresh_term_evars false true t; t)
   in
     if !modified then !evdref, t' else !evdref, t
@@ -140,7 +153,7 @@ let recheck_applications conv_algo env evdref t =
        let argsty = Array.map (fun x -> aux env x; Retyping.get_type_of env !evdref x) args in
        let rec aux i ty =
 	 if i < Array.length argsty then
-	 match kind_of_term (whd_betadeltaiota env !evdref ty) with
+	 match kind_of_term (whd_all env !evdref ty) with
 	 | Prod (na, dom, codom) ->
 	    (match conv_algo env !evdref Reduction.CUMUL argsty.(i) dom with
 	     | Success evd -> evdref := evd;
@@ -164,7 +177,7 @@ type 'a update =
 | NoUpdate
 
 open Context.Named.Declaration
-let inst_of_vars sign = Array.map_of_list (mkVar % get_id) sign
+let inst_of_vars sign = Array.map_of_list (get_id %> mkVar) sign
 
 let restrict_evar_key evd evk filter candidates =
   match filter, candidates with
@@ -212,30 +225,29 @@ let restrict_instance evd evk filter argsv =
 open Context.Rel.Declaration
 let noccur_evar env evd evk c =
   let cache = ref Int.Set.empty (* cache for let-ins *) in
-  let rec occur_rec (k, env as acc) c =
+  let rec occur_rec check_types (k, env as acc) c =
   match kind_of_term c with
   | Evar (evk',args' as ev') ->
       (match safe_evar_value evd ev' with
-       | Some c -> occur_rec acc c
+       | Some c -> occur_rec check_types acc c
        | None ->
            if Evar.equal evk evk' then raise Occur
-           else Array.iter (occur_rec acc) args')
+           else (if check_types then
+                   occur_rec false acc (existential_type evd ev');
+                 Array.iter (occur_rec check_types acc) args'))
   | Rel i when i > k ->
-      if not (Int.Set.mem (i-k) !cache) then
-      (match Environ.lookup_rel i env with
-       | LocalAssum _ -> ()
-       | LocalDef (_,b,_) -> cache := Int.Set.add (i-k) !cache; occur_rec acc (lift i b))
-  | Proj (p,c) -> 
-    let c = 
-      try Retyping.expand_projection env evd p c []
-      with Retyping.RetypeError _ -> 
-	(* Can happen when called from w_unify which doesn't assign evars/metas 
-	   eagerly enough *) c
-    in occur_rec acc c
+     if not (Int.Set.mem (i-k) !cache) then
+       let decl = Environ.lookup_rel i env in
+       if check_types then
+         (cache := Int.Set.add (i-k) !cache; occur_rec false acc (lift i (get_type decl)));
+       (match decl with
+        | LocalAssum _ -> ()
+        | LocalDef (_,b,_) -> cache := Int.Set.add (i-k) !cache; occur_rec false acc (lift i b))
+  | Proj (p,c) -> occur_rec true acc c
   | _ -> iter_constr_with_full_binders (fun rd (k,env) -> (succ k, push_rel rd env))
-    occur_rec acc c
+    (occur_rec check_types) acc c
   in
-  try occur_rec (0,env) c; true with Occur -> false
+  try occur_rec false (0,env) c; true with Occur -> false
 
 (***************************************)
 (* Managing chains of local definitons *)
@@ -520,7 +532,7 @@ let solve_pattern_eqn env l c =
     l c in
   (* Warning: we may miss some opportunity to eta-reduce more since c'
      is not in normal form *)
-  whd_eta c'
+  shrink_eta c'
 
 (*****************************************)
 (* Refining/solving unification problems *)
@@ -609,7 +621,13 @@ let define_evar_from_virtual_equation define_fun env evd src t_in_env ty_t_in_si
  * substitution u1..uq.
  *)
 
+exception MorePreciseOccurCheckNeeeded
+
 let materialize_evar define_fun env evd k (evk1,args1) ty_in_env =
+  if Evd.is_defined evd evk1 then
+      (* Some circularity somewhere (see e.g. #3209) *)
+      raise MorePreciseOccurCheckNeeeded;
+  let (evk1,args1) = destEvar (whd_evar evd (mkEvar (evk1,args1))) in
   let evi1 = Evd.find_undefined evd evk1 in
   let env1,rel_sign = env_rel_context_chop k env in
   let sign1 = evar_hyps evi1 in
@@ -628,13 +646,13 @@ let materialize_evar define_fun env evd k (evk1,args1) ty_in_env =
 	 ~status:univ_flexible (Some false) env evd (mkSort s) in
         define_evar_from_virtual_equation define_fun env evd src t_in_env
           ty_t_in_sign sign filter inst_in_env in
-      let evd,b_in_sign = match d with
-      | LocalAssum _ -> evd,None
+      let evd,d' = match d with
+      | LocalAssum _ -> evd, Context.Named.Declaration.LocalAssum (id,t_in_sign)
       | LocalDef (_,b,_) ->
           let evd,b = define_evar_from_virtual_equation define_fun env evd src b
             t_in_sign sign filter inst_in_env in
-          evd,Some b in
-      (push_named_context_val (Context.Named.Declaration.of_tuple (id,b_in_sign,t_in_sign)) sign, Filter.extend 1 filter,
+          evd, Context.Named.Declaration.LocalDef (id,b,t_in_sign) in
+      (push_named_context_val d' sign, Filter.extend 1 filter,
        (mkRel 1)::(List.map (lift 1) inst_in_env),
        (mkRel 1)::(List.map (lift 1) inst_in_sign),
        push_rel d env,evd,id::avoid))
@@ -797,7 +815,7 @@ let rec do_projection_effects define_fun env ty evd = function
       let evd = Evd.define evk (mkVar id) evd in
       (* TODO: simplify constraints involving evk *)
       let evd = do_projection_effects define_fun env ty evd p in
-      let ty = whd_betadeltaiota env evd (Lazy.force ty) in
+      let ty = whd_all env evd (Lazy.force ty) in
       if not (isSort ty) then
         (* Don't try to instantiate if a sort because if evar_concl is an
            evar it may commit to a univ level which is not the right
@@ -1460,7 +1478,7 @@ let rec invert_definition conv_algo choose env evd pbty (evk,argsv as ev) rhs =
                   map_constr_with_full_binders (fun d (env,k) -> push_rel d env, k+1)
                     imitate envk t in
                 t::l
-              with e when Errors.noncritical e -> l in
+              with e when CErrors.noncritical e -> l in
             (match candidates with
             | [x] -> x
             | _ ->
@@ -1549,11 +1567,13 @@ and evar_define conv_algo ?(choose=false) env evd pbty (evk,argsv as ev) rhs =
         postpone_non_unique_projection env evd pbty ev sols rhs
     | NotEnoughInformationEvarEvar t ->
         add_conv_oriented_pb (pbty,env,mkEvar ev,t) evd
+    | MorePreciseOccurCheckNeeeded ->
+        add_conv_oriented_pb (pbty,env,mkEvar ev,rhs) evd
     | NotInvertibleUsingOurAlgorithm _ | MetaOccurInBodyInternal as e ->
         raise e
     | OccurCheckIn (evd,rhs) ->
         (* last chance: rhs actually reduces to ev *)
-        let c = whd_betadeltaiota env evd rhs in
+        let c = whd_all env evd rhs in
         match kind_of_term c with
         | Evar (evk',argsv2) when Evar.equal evk evk' ->
 	    solve_refl (fun env sigma pb c c' -> is_fconv pb env sigma c c')
@@ -1591,7 +1611,7 @@ let status_changed lev (pbty,_,t1,t2) =
   (try Evar.Set.mem (head_evar t1) lev with NoHeadEvar -> false) ||
   (try Evar.Set.mem (head_evar t2) lev with NoHeadEvar -> false)
 
-let reconsider_conv_pbs conv_algo evd =
+let reconsider_unif_constraints conv_algo evd =
   let (evd,pbs) = extract_changed_conv_pbs evd status_changed in
   List.fold_left
     (fun p (pbty,env,t1,t2 as x) ->
@@ -1604,6 +1624,8 @@ let reconsider_conv_pbs conv_algo evd =
     (Success evd)
     pbs
 
+let reconsider_conv_pbs = reconsider_unif_constraints
+
 (* Tries to solve problem t1 = t2.
  * Precondition: t1 is an uninstantiated evar
  * Returns an optional list of evars that were instantiated, or None
@@ -1614,7 +1636,7 @@ let solve_simple_eqn conv_algo ?(choose=false) env evd (pbty,(evk1,args1 as ev1)
   try
     let t2 = whd_betaiota evd t2 in (* includes whd_evar *)
     let evd = evar_define conv_algo ~choose env evd pbty ev1 t2 in
-      reconsider_conv_pbs conv_algo evd
+      reconsider_unif_constraints conv_algo evd
   with
     | NotInvertibleUsingOurAlgorithm t ->
         UnifFailure (evd,NotClean (ev1,env,t))
diff --git a/pretyping/evarsolve.mli b/pretyping/evarsolve.mli
index 918ba12f0..b6bdc0788 100644
--- a/pretyping/evarsolve.mli
+++ b/pretyping/evarsolve.mli
@@ -34,8 +34,12 @@ type conv_fun_bool =
 val evar_define : conv_fun -> ?choose:bool -> env -> evar_map -> 
   bool option -> existential -> constr -> evar_map
 
-val refresh_universes : ?status:Evd.rigid ->
-			?onlyalg:bool (* Only algebraic universes *) ->
+val refresh_universes :
+  ?status:Evd.rigid ->
+  ?onlyalg:bool (* Only algebraic universes *) ->
+  ?refreshset:bool ->
+  (* Also refresh Prop and Set universes, so that the returned type can be any supertype
+     of the original type *)
   bool option (* direction: true for levels lower than the existing levels *) ->
   env -> evar_map -> types -> evar_map * types
 
@@ -50,7 +54,10 @@ val solve_evar_evar : ?force:bool ->
 val solve_simple_eqn : conv_fun -> ?choose:bool -> env ->  evar_map ->
   bool option * existential * constr -> unification_result
 
+val reconsider_unif_constraints : conv_fun -> evar_map -> unification_result
+
 val reconsider_conv_pbs : conv_fun -> evar_map -> unification_result
+(** @deprecated Alias for [reconsider_unif_constraints] *)
 
 val is_unification_pattern_evar : env -> evar_map -> existential -> constr list ->
   constr -> constr list option
diff --git a/pretyping/find_subterm.ml b/pretyping/find_subterm.ml
index ae8b91c34..4b9cf415f 100644
--- a/pretyping/find_subterm.ml
+++ b/pretyping/find_subterm.ml
@@ -8,7 +8,7 @@
 
 open Pp
 open Util
-open Errors
+open CErrors
 open Names
 open Locus
 open Term
@@ -16,6 +16,8 @@ open Nameops
 open Termops
 open Pretype_errors
 
+module NamedDecl = Context.Named.Declaration
+
 (** Processing occurrences *)
 
 type occurrence_error =
@@ -35,7 +37,7 @@ let explain_occurrence_error = function
   | IncorrectInValueOccurrence id -> explain_incorrect_in_value_occurrence id
 
 let error_occurrences_error e =
-  errorlabstrm "" (explain_occurrence_error e)
+  user_err  (explain_occurrence_error e)
 
 let error_invalid_occurrence occ =
   error_occurrences_error (InvalidOccurrence occ)
@@ -61,7 +63,7 @@ let proceed_with_occurrences f occs x =
 
 let map_named_declaration_with_hyploc f hyploc acc decl =
   let open Context.Named.Declaration in
-  let f = f (Some (get_id decl, hyploc)) in
+  let f = f (Some (NamedDecl.get_id decl, hyploc)) in
   match decl,hyploc with
   | LocalAssum (id,_), InHypValueOnly ->
       error_occurrences_error (IncorrectInValueOccurrence id)
@@ -108,7 +110,6 @@ let replace_term_occ_gen_modulo occs like_first test bywhat cl occ t =
      raise (SubtermUnificationError (!nested,((cl,!pos),t),lastpos,e)) in
   let rec substrec k t =
     if nowhere_except_in && !pos > maxocc then t else
-    if not (Vars.closed0 t) then subst_below k t else
     try
       let subst = test.match_fun test.testing_state t in
       if Locusops.is_selected !pos occs then
diff --git a/pretyping/glob_ops.ml b/pretyping/glob_ops.ml
index 04100c8a7..51660818f 100644
--- a/pretyping/glob_ops.ml
+++ b/pretyping/glob_ops.ml
@@ -334,10 +334,14 @@ let glob_visible_short_qualid c =
         fold_glob_constr aux acc c
   in aux [] c
 
+let warn_variable_collision =
+  let open Pp in
+  CWarnings.create ~name:"variable-collision" ~category:"ltac"
+         (fun name ->
+          strbrk "Collision between bound variables of name " ++ pr_id name)
+
 let add_and_check_ident id set =
-  if Id.Set.mem id set then
-    Feedback.msg_warning
-      Pp.(str "Collision between bound variables of name " ++ Id.print id);
+  if Id.Set.mem id set then warn_variable_collision id;
   Id.Set.add id set
 
 let bound_glob_vars =
@@ -466,6 +470,78 @@ let loc_of_glob_constr = function
   | GCast (loc,_,_) -> loc
 
 (**********************************************************************)
+(* Alpha-renaming                                                     *)
+
+let collide_id l id = List.exists (fun (id',id'') -> Id.equal id id' || Id.equal id id'') l
+let test_id l id = if collide_id l id then raise Not_found
+let test_na l na = name_iter (test_id l) na
+
+let update_subst na l =
+  let in_range id l = List.exists (fun (_,id') -> Id.equal id id') l in
+  let l' = name_fold Id.List.remove_assoc na l in
+  name_fold
+    (fun id _ ->
+     if in_range id l' then
+       let id' = Namegen.next_ident_away_from id (fun id' -> in_range id' l') in
+       Name id', (id,id')::l
+     else na,l)
+    na (na,l)
+
+exception UnsoundRenaming
+
+let rename_var l id =
+  try
+    let id' = Id.List.assoc id l in
+    (* Check that no other earlier binding hide the one found *)
+    let _,(id'',_) = List.extract_first (fun (_,id) -> Id.equal id id') l in
+    if Id.equal id id'' then id' else raise UnsoundRenaming
+  with Not_found ->
+    if List.exists (fun (_,id') -> Id.equal id id') l then raise UnsoundRenaming
+    else id
+
+let rec rename_glob_vars l = function
+  | GVar (loc,id) as r ->
+      let id' = rename_var l id in
+      if id == id' then r else GVar (loc,id')
+  | GRef (_,VarRef id,_) as r ->
+      if List.exists (fun (_,id') -> Id.equal id id') l then raise UnsoundRenaming
+      else r
+  | GProd (loc,na,bk,t,c) ->
+      let na',l' = update_subst na l in
+      GProd (loc,na,bk,rename_glob_vars l t,rename_glob_vars l' c)
+  | GLambda (loc,na,bk,t,c) ->
+      let na',l' = update_subst na l in
+      GLambda (loc,na',bk,rename_glob_vars l t,rename_glob_vars l' c)
+  | GLetIn (loc,na,b,c) ->
+      let na',l' = update_subst na l in
+      GLetIn (loc,na',rename_glob_vars l b,rename_glob_vars l' c)
+  (* Lazy strategy: we fail if a collision with renaming occurs, rather than renaming further *)
+  | GCases (loc,ci,po,tomatchl,cls) ->
+      let test_pred_pat (na,ino) =
+        test_na l na; Option.iter (fun (_,_,nal) -> List.iter (test_na l) nal) ino in
+      let test_clause idl = List.iter (test_id l) idl in
+      let po = Option.map (rename_glob_vars l) po in
+      let tomatchl = Util.List.map_left (fun (tm,x) -> test_pred_pat x; (rename_glob_vars l tm,x)) tomatchl in
+      let cls = Util.List.map_left (fun (loc,idl,p,c) -> test_clause idl; (loc,idl,p,rename_glob_vars l c)) cls in
+      GCases (loc,ci,po,tomatchl,cls)
+  | GLetTuple (loc,nal,(na,po),c,b) ->
+     List.iter (test_na l) (na::nal);
+     GLetTuple (loc,nal,(na,Option.map (rename_glob_vars l) po),
+                rename_glob_vars l c,rename_glob_vars l b)
+  | GIf (loc,c,(na,po),b1,b2) ->
+     test_na l na;
+     GIf (loc,rename_glob_vars l c,(na,Option.map (rename_glob_vars l) po),
+          rename_glob_vars l b1,rename_glob_vars l b2)
+  | GRec (loc,k,idl,decls,bs,ts) ->
+     Array.iter (test_id l) idl;
+     GRec (loc,k,idl,
+           Array.map (List.map (fun (na,k,bbd,bty) ->
+             test_na l na; (na,k,Option.map (rename_glob_vars l) bbd,rename_glob_vars l bty))) decls,
+           Array.map (rename_glob_vars l) bs,
+           Array.map (rename_glob_vars l) ts)
+  | r -> map_glob_constr (rename_glob_vars l) r
+
+(**********************************************************************)
 (* Conversion from glob_constr to cases pattern, if possible            *)
 
 let rec cases_pattern_of_glob_constr na = function
diff --git a/pretyping/glob_ops.mli b/pretyping/glob_ops.mli
index e0a2de032..55e6b6533 100644
--- a/pretyping/glob_ops.mli
+++ b/pretyping/glob_ops.mli
@@ -34,6 +34,8 @@ val map_glob_constr :
 val map_glob_constr_left_to_right :
   (glob_constr -> glob_constr) -> glob_constr -> glob_constr
 
+val warn_variable_collision : ?loc:Loc.t -> Id.t -> unit
+
 val fold_glob_constr : ('a -> glob_constr -> 'a) -> 'a -> glob_constr -> 'a
 val iter_glob_constr : (glob_constr -> unit) -> glob_constr -> unit
 val occur_glob_constr : Id.t -> glob_constr -> bool
@@ -42,6 +44,16 @@ val bound_glob_vars : glob_constr -> Id.Set.t
 val loc_of_glob_constr : glob_constr -> Loc.t
 val glob_visible_short_qualid : glob_constr -> Id.t list
 
+(* Renaming free variables using a renaming map; fails with
+   [UnsoundRenaming] if applying the renaming would introduce
+   collision, as in, e.g., renaming [P x y] using substitution [(x,y)];
+   inner alpha-conversion done only for forall, fun, let but
+   not for cases and fix *)
+
+exception UnsoundRenaming
+val rename_var : (Id.t * Id.t) list -> Id.t -> Id.t
+val rename_glob_vars : (Id.t * Id.t) list -> glob_constr -> glob_constr
+
 (** [map_pattern_binders f m c] applies [f] to all the binding names
     in a pattern-matching expression ({!Glob_term.GCases}) represented
     here by its relevant components [m] and [c]. It is used to
diff --git a/pretyping/indrec.ml b/pretyping/indrec.ml
index 5d36fc78e..9cf91a947 100644
--- a/pretyping/indrec.ml
+++ b/pretyping/indrec.ml
@@ -11,7 +11,7 @@
 (* This file builds various inductive schemes *)
 
 open Pp
-open Errors
+open CErrors
 open Util
 open Names
 open Libnames
@@ -36,12 +36,14 @@ type dep_flag = bool
 type recursion_scheme_error =
   | NotAllowedCaseAnalysis of (*isrec:*) bool * sorts * pinductive
   | NotMutualInScheme of inductive * inductive
+  | NotAllowedDependentAnalysis of (*isrec:*) bool * inductive
 
 exception RecursionSchemeError of recursion_scheme_error
 
 let make_prod_dep dep env = if dep then mkProd_name env else mkProd
 let mkLambda_string s t c = mkLambda (Name (Id.of_string s), t, c)
 
+
 (*******************************************)
 (* Building curryfied elimination          *)
 (*******************************************)
@@ -53,7 +55,7 @@ let is_private mib =
 
 let check_privacy_block mib =
   if is_private mib then
-    errorlabstrm ""(str"case analysis on a private inductive type")
+    user_err (str"case analysis on a private inductive type")
       
 (**********************************************************************)
 (* Building case analysis schemes *)
@@ -151,7 +153,7 @@ let type_rec_branch is_rec dep env sigma (vargs,depPvect,decP) tyi cs recargs =
   let nparams = List.length vargs in
   let process_pos env depK pk =
     let rec prec env i sign p =
-      let p',largs = whd_betadeltaiota_nolet_stack env sigma p in
+      let p',largs = whd_allnolet_stack env sigma p in
       match kind_of_term p' with
 	| Prod (n,t,c) ->
 	    let d = LocalAssum (n,t) in
@@ -168,7 +170,7 @@ let type_rec_branch is_rec dep env sigma (vargs,depPvect,decP) tyi cs recargs =
             else
 	      base
       	| _ ->
-	   let t' = whd_betadeltaiota env sigma p in
+	   let t' = whd_all env sigma p in
 	   if Term.eq_constr p' t' then assert false
 	   else prec env i sign t'
     in
@@ -183,9 +185,7 @@ let type_rec_branch is_rec dep env sigma (vargs,depPvect,decP) tyi cs recargs =
               | ra::rest ->
                   (match dest_recarg ra with
 	            | Mrec (_,j) when is_rec -> (depPvect.(j),rest)
-	            | Imbr _  ->
-		        Feedback.msg_warning (strbrk "Ignoring recursive call");
-		        (None,rest)
+	            | Imbr _  -> (None,rest)
                     | _ -> (None, rest))
 	  in
           (match optionpos with
@@ -229,7 +229,7 @@ let type_rec_branch is_rec dep env sigma (vargs,depPvect,decP) tyi cs 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
+      let p',largs = whd_allnolet_stack env sigma p in
       match kind_of_term p' with
 	| Prod (n,t,c) ->
 	    let d = LocalAssum (n,t) in
@@ -242,7 +242,7 @@ let make_rec_branch_arg env sigma (nparrec,fvect,decF) f cstr recargs =
             and arg = appvect (mkRel (i+1), Context.Rel.to_extended_vect 0 hyps) in
             applist(lift i fk,realargs@[arg])
      	| _ ->
-	   let t' = whd_betadeltaiota env sigma p in
+	   let t' = whd_all env sigma p in
 	     if Term.eq_constr t' p' then assert false
 	     else prec env i hyps t'
     in
@@ -377,27 +377,9 @@ let mis_make_indrec env sigma listdepkind mib u =
 		      (Anonymous,depind',concl))
 		  arsign'
 	      in
-	      let obj = 
-		let projs = get_projections env indf in
-		  match projs with
-		  | None -> (mkCase (ci, pred,
-				     mkRel 1,
-				     branches))
-		  | Some ps -> 
-		    let branch = branches.(0) in
-		    let ctx, br = decompose_lam_assum branch in
-		    let n, subst = 
-		      List.fold_right (fun decl (i, subst) ->
-			match decl with
-			| LocalAssum (na,t) ->
-			    let t = mkProj (Projection.make ps.(i) true, mkRel 1) in
-			    i + 1, t :: subst
-			| LocalDef (na,b,t) ->
-			    i, mkRel 0 :: subst)
-			ctx (0, [])
-		    in
-		    let term = substl subst br in
-		      term
+	      let obj =
+		Inductiveops.make_case_or_project env indf ci pred
+						  (mkRel 1) branches
 	      in
 		it_mkLambda_or_LetIn_name env obj
 		  (Termops.lift_rel_context nrec deparsign)
@@ -485,6 +467,8 @@ let mis_make_indrec env sigma listdepkind mib u =
 
 let build_case_analysis_scheme env sigma pity dep kind =
   let (mib,mip) = lookup_mind_specif env (fst pity) in
+  if dep && not (Inductiveops.has_dependent_elim mib) then
+    raise (RecursionSchemeError (NotAllowedDependentAnalysis (false, fst pity)));
   mis_make_case_com dep env sigma pity (mib,mip) kind
 
 let is_in_prop mip =
@@ -494,7 +478,7 @@ let is_in_prop mip =
 
 let build_case_analysis_scheme_default env sigma pity kind =
   let (mib,mip) = lookup_mind_specif env (fst pity) in
-  let dep = not (is_in_prop mip) in
+  let dep = not (is_in_prop mip || not (Inductiveops.has_dependent_elim mib)) in
   mis_make_case_com dep env sigma pity (mib,mip) kind
 
 (**********************************************************************)
@@ -555,6 +539,8 @@ let check_arities env listdepkind =
 let build_mutual_induction_scheme env sigma = function
   | ((mind,u),dep,s)::lrecspec ->
       let (mib,mip) = lookup_mind_specif env mind in
+      if dep && not (Inductiveops.has_dependent_elim mib) then
+        raise (RecursionSchemeError (NotAllowedDependentAnalysis (true, mind)));
       let (sp,tyi) = mind in
       let listdepkind =
 	((mind,u),mib,mip,dep,s)::
@@ -574,6 +560,8 @@ let build_mutual_induction_scheme env sigma = function
 
 let build_induction_scheme env sigma pind dep kind =
   let (mib,mip) = lookup_mind_specif env (fst pind) in
+  if dep && not (Inductiveops.has_dependent_elim mib) then
+    raise (RecursionSchemeError (NotAllowedDependentAnalysis (true, fst pind)));
   let sigma, l = mis_make_indrec env sigma [(pind,mib,mip,dep,kind)] mib (snd pind) in
     sigma, List.hd l
 
@@ -606,7 +594,7 @@ let lookup_eliminator ind_sp s =
   (* using short name (e.g. for "eq_rec") *)
   try Nametab.locate (qualid_of_ident id)
   with Not_found ->
-    errorlabstrm "default_elim"
+    user_err ~hdr:"default_elim"
       (strbrk "Cannot find the elimination combinator " ++
        pr_id id ++ strbrk ", the elimination of the inductive definition " ++
        pr_global_env Id.Set.empty (IndRef ind_sp) ++
diff --git a/pretyping/indrec.mli b/pretyping/indrec.mli
index f0736d2dd..192b64a5e 100644
--- a/pretyping/indrec.mli
+++ b/pretyping/indrec.mli
@@ -16,6 +16,7 @@ open Evd
 type recursion_scheme_error =
   | NotAllowedCaseAnalysis of (*isrec:*) bool * sorts * pinductive
   | NotMutualInScheme of inductive * inductive
+  | NotAllowedDependentAnalysis of (*isrec:*) bool * inductive
 
 exception RecursionSchemeError of recursion_scheme_error
 
@@ -28,13 +29,15 @@ type dep_flag = bool
 val build_case_analysis_scheme : env -> 'r Sigma.t -> pinductive ->
       dep_flag -> sorts_family -> (constr, 'r) Sigma.sigma
 
-(** Build a dependent case elimination predicate unless type is in Prop *)
+(** Build a dependent case elimination predicate unless type is in Prop
+   or is a recursive record with primitive projections. *)
 
 val build_case_analysis_scheme_default : env -> 'r Sigma.t -> pinductive ->
       sorts_family -> (constr, 'r) Sigma.sigma
 
 (** Builds a recursive induction scheme (Peano-induction style) in the same
-   sort family as the inductive family; it is dependent if not in Prop *)
+   sort family as the inductive family; it is dependent if not in Prop
+   or a recursive record with primitive projections.  *)
 
 val build_induction_scheme : env -> evar_map -> pinductive ->
       dep_flag -> sorts_family -> evar_map * constr
diff --git a/pretyping/inductiveops.ml b/pretyping/inductiveops.ml
index 80f1988a9..ac6d775e3 100644
--- a/pretyping/inductiveops.ml
+++ b/pretyping/inductiveops.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-open Errors
+open CErrors
 open Util
 open Names
 open Univ
@@ -24,14 +24,14 @@ open Context.Rel.Declaration
 
 let type_of_inductive env (ind,u) =
  let (mib,_ as specif) = Inductive.lookup_mind_specif env ind in
- Typeops.check_hyps_inclusion env (mkInd ind) mib.mind_hyps;
+ Typeops.check_hyps_inclusion env mkInd ind mib.mind_hyps;
  Inductive.type_of_inductive env (specif,u)
 
 (* Return type as quoted by the user *)
 let type_of_constructor env (cstr,u) =
  let (mib,_ as specif) =
    Inductive.lookup_mind_specif env (inductive_of_constructor cstr) in
- Typeops.check_hyps_inclusion env (mkConstruct cstr) mib.mind_hyps;
+ Typeops.check_hyps_inclusion env mkConstruct cstr mib.mind_hyps;
  Inductive.type_of_constructor (cstr,u) specif
 
 (* Return constructor types in user form *)
@@ -269,6 +269,11 @@ let projection_nparams_env env p =
 
 let projection_nparams p = projection_nparams_env (Global.env ()) p
 
+let has_dependent_elim mib =
+  match mib.mind_record with
+  | Some (Some _) -> mib.mind_finite == Decl_kinds.BiFinite
+  | _ -> true
+
 (* Annotation for cases *)
 let make_case_info env ind style =
   let (mib,mip) = Inductive.lookup_mind_specif env ind in
@@ -338,6 +343,35 @@ let get_projections env (ind,params) =
     | Some (Some (id, projs, pbs)) -> Some projs
     | _ -> None
 
+let make_case_or_project env indf ci pred c branches =
+  let projs = get_projections env indf in
+  match projs with
+  | None -> (mkCase (ci, pred, c, branches))
+  | Some ps ->
+     assert(Array.length branches == 1);
+     let () =
+       let _, _, t = destLambda pred in
+       let (ind, _), _ = dest_ind_family indf in
+       let mib, _ = Inductive.lookup_mind_specif env ind in
+       if (* dependent *) not (noccurn 1 t) &&
+          not (has_dependent_elim mib) then
+       user_err ~hdr:"make_case_or_project"
+		    Pp.(str"Dependent case analysis not allowed" ++
+		     str" on inductive type " ++ Names.MutInd.print (fst ind))
+     in
+     let branch = branches.(0) in
+     let ctx, br = decompose_lam_n_assum (Array.length ps) branch in
+     let n, subst =
+       List.fold_right
+         (fun decl (i, subst) ->
+	  match decl with
+	  | LocalAssum (na, t) ->
+	     let t = mkProj (Projection.make ps.(i) true, c) in
+	     (i + 1, t :: subst)
+	  | LocalDef (na, b, t) -> (i, substl subst b :: subst))
+	 ctx (0, [])
+     in substl subst br
+
 (* substitution in a signature *)
 
 let substnl_rel_context subst n sign =
@@ -417,7 +451,7 @@ let extract_mrectype t =
     | _ -> raise Not_found
 
 let find_mrectype_vect env sigma c =
-  let (t, l) = decompose_appvect (whd_betadeltaiota env sigma c) in
+  let (t, l) = decompose_appvect (whd_all env sigma c) in
   match kind_of_term t with
     | Ind ind -> (ind, l)
     | _ -> raise Not_found
@@ -426,7 +460,7 @@ let find_mrectype env sigma c =
   let (ind, v) = find_mrectype_vect env sigma c in (ind, Array.to_list v)
 
 let find_rectype env sigma c =
-  let (t, l) = decompose_app (whd_betadeltaiota env sigma c) in
+  let (t, l) = decompose_app (whd_all env sigma c) in
   match kind_of_term t with
     | Ind (ind,u as indu) ->
         let (mib,mip) = Inductive.lookup_mind_specif env ind in
@@ -436,7 +470,7 @@ let find_rectype env sigma c =
     | _ -> raise Not_found
 
 let find_inductive env sigma c =
-  let (t, l) = decompose_app (whd_betadeltaiota env sigma c) in
+  let (t, l) = decompose_app (whd_all env sigma c) in
   match kind_of_term t with
     | Ind ind
         when (fst (Inductive.lookup_mind_specif env (fst ind))).mind_finite <> Decl_kinds.CoFinite ->
@@ -444,7 +478,7 @@ let find_inductive env sigma c =
     | _ -> raise Not_found
 
 let find_coinductive env sigma c =
-  let (t, l) = decompose_app (whd_betadeltaiota env sigma c) in
+  let (t, l) = decompose_app (whd_all env sigma c) in
   match kind_of_term t with
     | Ind ind
         when (fst (Inductive.lookup_mind_specif env (fst ind))).mind_finite == Decl_kinds.CoFinite ->
@@ -458,7 +492,7 @@ let find_coinductive env sigma c =
 
 let is_predicate_explicitly_dep env pred arsign =
   let rec srec env pval arsign =
-    let pv' = whd_betadeltaiota env Evd.empty pval in
+    let pv' = whd_all env Evd.empty pval in
     match kind_of_term pv', arsign with
       | Lambda (na,t,b), (LocalAssum _)::arsign ->
 	  srec (push_rel_assum (na,t) env) b arsign
@@ -581,7 +615,7 @@ let type_of_projection_knowing_arg env sigma p c ty =
       raise (Invalid_argument "type_of_projection_knowing_arg_type: not an inductive type")
   in
   let (_,u), pars = dest_ind_family pars in
-  substl (c :: List.rev pars) (Typeops.type_of_projection env (p,u))
+  substl (c :: List.rev pars) (Typeops.type_of_projection_constant env (p,u))
 
 (***********************************************)
 (* Guard condition *)
@@ -592,9 +626,9 @@ let type_of_projection_knowing_arg env sigma p c ty =
 let control_only_guard env c =
   let check_fix_cofix e c = match kind_of_term c with
     | CoFix (_,(_,_,_) as cofix) ->
-	Inductive.check_cofix e cofix
+      Inductive.check_cofix e cofix
     | Fix (_,(_,_,_) as fix) ->
-	Inductive.check_fix e fix
+      Inductive.check_fix e fix
     | _ -> ()
   in
   let rec iter env c =
diff --git a/pretyping/inductiveops.mli b/pretyping/inductiveops.mli
index d25f8a837..7bd616591 100644
--- a/pretyping/inductiveops.mli
+++ b/pretyping/inductiveops.mli
@@ -122,11 +122,16 @@ val inductive_has_local_defs : inductive -> bool
 
 val allowed_sorts : env -> inductive -> sorts_family list
 
+(** (Co)Inductive records with primitive projections do not have eta-conversion,
+    hence no dependent elimination. *)
+val has_dependent_elim : mutual_inductive_body -> bool
+
 (** Primitive projections *)
 val projection_nparams : projection -> int
 val projection_nparams_env : env -> projection -> int
 val type_of_projection_knowing_arg : env -> evar_map -> Projection.t ->
-  constr -> types -> types
+				     constr -> types -> types
+
 
 (** Extract information from an inductive family *)
 
@@ -175,6 +180,14 @@ val type_case_branches_with_names :
 (** Annotation for cases *)
 val make_case_info : env -> inductive -> case_style -> case_info
 
+(** Make a case or substitute projections if the inductive type is a record
+    with primitive projections.
+    Fail with an error if the elimination is dependent while the
+    inductive type does not allow dependent elimination. *)
+val make_case_or_project :
+  env -> inductive_family -> case_info ->
+  (* pred *) constr -> (* term *) constr -> (* branches *) constr array -> constr
+
 (*i Compatibility
 val make_default_case_info : env -> case_style -> inductive -> case_info
 i*)
diff --git a/pretyping/locusops.ml b/pretyping/locusops.ml
index d89aeccd8..e4fbf8d54 100644
--- a/pretyping/locusops.ml
+++ b/pretyping/locusops.ml
@@ -50,9 +50,9 @@ let is_nowhere = function
 
 let simple_clause_of enum_hyps cl =
   let error_occurrences () =
-    Errors.error "This tactic does not support occurrences selection" in
+    CErrors.error "This tactic does not support occurrences selection" in
   let error_body_selection () =
-    Errors.error "This tactic does not support body selection" in
+    CErrors.error "This tactic does not support body selection" in
   let hyps =
     match cl.onhyps with
     | None ->
@@ -84,7 +84,7 @@ let concrete_clause_of enum_hyps cl =
 (** Miscellaneous functions *)
 
 let out_arg = function
-  | Misctypes.ArgVar _ -> Errors.anomaly (Pp.str "Unevaluated or_var variable")
+  | Misctypes.ArgVar _ -> CErrors.anomaly (Pp.str "Unevaluated or_var variable")
   | Misctypes.ArgArg x -> x
 
 let occurrences_of_hyp id cls =
diff --git a/pretyping/nativenorm.ml b/pretyping/nativenorm.ml
index 2a5e99965..1e5f12b20 100644
--- a/pretyping/nativenorm.ml
+++ b/pretyping/nativenorm.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 open Pp
-open Errors
+open CErrors
 open Term
 open Vars
 open Environ
@@ -20,6 +20,8 @@ open Nativecode
 open Nativevalues
 open Context.Rel.Declaration
 
+module RelDecl = Context.Rel.Declaration
+
 (** This module implements normalization by evaluation to OCaml code *)
 
 exception Find_at of int
@@ -35,13 +37,13 @@ let invert_tag cst tag reloc_tbl =
   with Find_at j -> (j+1)
 
 let decompose_prod env t =
-  let (name,dom,codom as res) = destProd (whd_betadeltaiota env t) in
+  let (name,dom,codom as res) = destProd (whd_all env t) in
   match name with
   | Anonymous -> (Name (id_of_string "x"),dom,codom)
   | _ -> res
 
 let app_type env c =
-  let t = whd_betadeltaiota env c in
+  let t = whd_all env c in
   try destApp t with DestKO -> (t,[||])
 
  
@@ -122,7 +124,7 @@ let build_case_type dep p realargs c =
 
 (* TODO move this function *)
 let type_of_rel env n =
-  lookup_rel n env |> get_type |> lift n
+  env |> lookup_rel n |> RelDecl.get_type |> lift n
 
 let type_of_prop = mkSort type1_sort
 
@@ -133,7 +135,7 @@ let type_of_sort s =
 
 let type_of_var env id =
   let open Context.Named.Declaration in
-  try lookup_named id env |> get_type
+  try env |> lookup_named id |> get_type
   with Not_found ->
     anomaly ~label:"type_of_var" (str "variable " ++ Id.print id ++ str " unbound")
 
@@ -178,7 +180,7 @@ let rec nf_val env v typ =
       let name,dom,codom = 
 	try decompose_prod env typ
 	with DestKO ->
-          Errors.anomaly
+          CErrors.anomaly
             (Pp.strbrk "Returned a functional value in a type not recognized as a product type.")
       in
       let env = push_rel (LocalAssum (name,dom)) env in
@@ -224,7 +226,7 @@ and nf_args env accu t =
     let _,dom,codom =
       try decompose_prod env t with
 	DestKO ->
-	Errors.anomaly
+	CErrors.anomaly
 	  (Pp.strbrk "Returned a functional value in a type not recognized as a product type.")
     in
     let c = nf_val env arg dom in
@@ -241,7 +243,7 @@ and nf_bargs env b t =
       let _,dom,codom =
 	try decompose_prod env !t with
 	  DestKO ->
-	  Errors.anomaly
+	  CErrors.anomaly
 	    (Pp.strbrk "Returned a functional value in a type not recognized as a product type.")
       in
       let c = nf_val env (block_field b i) dom in
@@ -289,7 +291,7 @@ and nf_atom_type env atom =
       let pT = 
 	hnf_prod_applist env 
 	  (Inductiveops.type_of_inductive env ind) (Array.to_list params) in
-      let pT = whd_betadeltaiota env pT in
+      let pT = whd_all env pT in
       let dep, p = nf_predicate env ind mip params p pT in
       (* Calcul du type des branches *)
       let btypes = build_branches_type env (fst ind) mib mip u params dep p in
@@ -352,7 +354,7 @@ and  nf_predicate env ind mip params v pT =
       let name,dom,codom =
 	try decompose_prod env pT with
 	  DestKO ->
-	  Errors.anomaly
+	  CErrors.anomaly
 	    (Pp.strbrk "Returned a functional value in a type not recognized as a product type.")
       in
       let dep,body = 
diff --git a/pretyping/patternops.ml b/pretyping/patternops.ml
index d6305d81a..9dcb5d2a5 100644
--- a/pretyping/patternops.ml
+++ b/pretyping/patternops.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-open Errors
+open CErrors
 open Util
 open Names
 open Globnames
@@ -204,7 +204,7 @@ let error_instantiate_pattern id l =
   | [_] -> "is" 
   | _ -> "are"
   in
-  errorlabstrm "" (str "Cannot substitute the term bound to " ++ pr_id id
+  user_err  (str "Cannot substitute the term bound to " ++ pr_id id
     ++ strbrk " in pattern because the term refers to " ++ pr_enum pr_id l
     ++ strbrk " which " ++ str is ++ strbrk " not bound in the pattern.")
 
@@ -315,7 +315,11 @@ let rec subst_pattern subst pat =
 let mkPLambda na b = PLambda(na,PMeta None,b)
 let rev_it_mkPLambda = List.fold_right mkPLambda
 
-let err loc pp = user_err_loc (loc,"pattern_of_glob_constr", pp)
+let err ?loc pp = user_err ?loc ~hdr:"pattern_of_glob_constr" pp
+
+let warn_cast_in_pattern =
+  CWarnings.create ~name:"cast-in-pattern" ~category:"automation"
+    (fun () -> Pp.strbrk "Casts are ignored in patterns")
 
 let rec pat_of_raw metas vars = function
   | GVar (_,id) ->
@@ -348,7 +352,7 @@ let rec pat_of_raw metas vars = function
   | GHole _ ->
       PMeta None
   | GCast (_,c,_) ->
-      Feedback.msg_warning (strbrk "Cast not taken into account in constr pattern");
+      warn_cast_in_pattern ();
       pat_of_raw metas vars c
   | GIf (_,c,(_,None),b1,b2) ->
       PIf (pat_of_raw metas vars c,
@@ -383,7 +387,7 @@ let rec pat_of_raw metas vars = function
           rev_it_mkPLambda nal (mkPLambda na (pat_of_raw metas nvars p))
         | (None | Some (GHole _)), _ -> PMeta None
 	| Some p, None ->
-            user_err_loc (loc,"",strbrk "Clause \"in\" expected in patterns over \"match\" expressions with an explicit \"return\" clause.")
+            user_err ~loc  (strbrk "Clause \"in\" expected in patterns over \"match\" expressions with an explicit \"return\" clause.")
       in
       let info =
 	{ cip_style = sty;
@@ -396,12 +400,12 @@ let rec pat_of_raw metas vars = function
 	 one non-trivial branch. These facts are used in [Constrextern]. *)
       PCase (info, pred, pat_of_raw metas vars c, brs)
 
-  | r -> err (loc_of_glob_constr r) (Pp.str "Non supported pattern.")
+  | r -> err ~loc:(loc_of_glob_constr r) (Pp.str "Non supported pattern.")
 
 and pats_of_glob_branches loc metas vars ind brs =
   let get_arg = function
     | PatVar(_,na) -> na
-    | PatCstr(loc,_,_,_) -> err loc (Pp.str "Non supported pattern.")
+    | PatCstr(loc,_,_,_) -> err ~loc (Pp.str "Non supported pattern.")
   in
   let rec get_pat indexes = function
     | [] -> false, []
@@ -410,10 +414,10 @@ and pats_of_glob_branches loc metas vars ind brs =
       let () = match ind with
       | Some sp when eq_ind sp indsp -> ()
       | _ ->
-        err loc (Pp.str "All constructors must be in the same inductive type.")
+        err ~loc (Pp.str "All constructors must be in the same inductive type.")
       in
       if Int.Set.mem (j-1) indexes then
-	err loc
+	err ~loc
           (str "No unique branch for " ++ int j ++ str"-th constructor.");
       let lna = List.map get_arg lv in
       let vars' = List.rev lna @ vars in
@@ -421,7 +425,7 @@ and pats_of_glob_branches loc metas vars ind brs =
       let ext,pats = get_pat (Int.Set.add (j-1) indexes) brs in
       let tags = List.map (fun _ -> false) lv (* approximation, w/o let-in *) in
       ext, ((j-1, tags, pat) :: pats)
-    | (loc,_,_,_) :: _ -> err loc (Pp.str "Non supported pattern.")
+    | (loc,_,_,_) :: _ -> err ~loc (Pp.str "Non supported pattern.")
   in
   get_pat Int.Set.empty brs
 
diff --git a/pretyping/pretype_errors.ml b/pretyping/pretype_errors.ml
index cf5b08c58..5b0958695 100644
--- a/pretyping/pretype_errors.ml
+++ b/pretyping/pretype_errors.ml
@@ -14,15 +14,16 @@ open Type_errors
 
 type unification_error =
   | OccurCheck of existential_key * constr
-  | NotClean of existential * env * constr
+  | NotClean of existential * env * constr (* Constr is a variable not in scope *)
   | NotSameArgSize
   | NotSameHead
   | NoCanonicalStructure
-  | ConversionFailed of env * constr * constr
+  | ConversionFailed of env * constr * constr (* Non convertible closed terms *)
   | MetaOccurInBody of existential_key
   | InstanceNotSameType of existential_key * env * types * types
   | UnifUnivInconsistency of Univ.univ_inconsistency
   | CannotSolveConstraint of Evd.evar_constraint * unification_error
+  | ProblemBeyondCapabilities
 
 type position = (Id.t * Locus.hyp_location_flag) option
 
@@ -59,47 +60,46 @@ type pretype_error =
 exception PretypeError of env * Evd.evar_map * pretype_error
 
 let precatchable_exception = function
-  | Errors.UserError _ | TypeError _ | PretypeError _
+  | CErrors.UserError _ | TypeError _ | PretypeError _
   | Nametab.GlobalizationError _ -> true
   | _ -> false
 
-let raise_pretype_error (loc,env,sigma,te) =
-  Loc.raise loc (PretypeError(env,sigma,te))
+let raise_pretype_error ?loc (env,sigma,te) =
+  Loc.raise ?loc (PretypeError(env,sigma,te))
 
-let raise_located_type_error (loc,env,sigma,te) =
-  Loc.raise loc (PretypeError(env,sigma,TypingError te))
+let raise_type_error ?loc (env,sigma,te) =
+  Loc.raise ?loc (PretypeError(env,sigma,TypingError te))
 
-
-let error_actual_type_loc loc env sigma {uj_val=c;uj_type=actty} expty reason =
+let error_actual_type ?loc env sigma {uj_val=c;uj_type=actty} expty reason =
   let j = {uj_val=c;uj_type=actty} in
-  raise_pretype_error
-    (loc, env, sigma, ActualTypeNotCoercible (j, expty, reason))
+  raise_pretype_error ?loc
+    (env, sigma, ActualTypeNotCoercible (j, expty, reason))
 
-let error_cant_apply_not_functional_loc loc env sigma rator randl =
-  raise_located_type_error
-    (loc, env, sigma, CantApplyNonFunctional (rator, Array.of_list randl))
+let error_cant_apply_not_functional ?loc env sigma rator randl =
+  raise_type_error ?loc
+    (env, sigma, CantApplyNonFunctional (rator, Array.of_list randl))
 
-let error_cant_apply_bad_type_loc loc env sigma (n,c,t) rator randl =
-  raise_located_type_error
-    (loc, env, sigma,
+let error_cant_apply_bad_type ?loc env sigma (n,c,t) rator randl =
+  raise_type_error ?loc
+    (env, sigma,
        CantApplyBadType ((n,c,t), rator, Array.of_list randl))
 
-let error_ill_formed_branch_loc loc env sigma c i actty expty =
-  raise_located_type_error
-    (loc, env, sigma, IllFormedBranch (c, i, actty, expty))
+let error_ill_formed_branch ?loc env sigma c i actty expty =
+  raise_type_error
+    ?loc (env, sigma, IllFormedBranch (c, i, actty, expty))
 
-let error_number_branches_loc loc env sigma cj expn =
-  raise_located_type_error (loc, env, sigma, NumberBranches (cj, expn))
+let error_number_branches ?loc env sigma cj expn =
+  raise_type_error ?loc (env, sigma, NumberBranches (cj, expn))
 
-let error_case_not_inductive_loc loc env sigma cj =
-  raise_located_type_error (loc, env, sigma, CaseNotInductive cj)
+let error_case_not_inductive ?loc env sigma cj =
+  raise_type_error ?loc (env, sigma, CaseNotInductive cj)
 
-let error_ill_typed_rec_body_loc loc env sigma i na jl tys =
-  raise_located_type_error
-    (loc, env, sigma, IllTypedRecBody (i, na, jl, tys))
+let error_ill_typed_rec_body ?loc env sigma i na jl tys =
+  raise_type_error ?loc
+    (env, sigma, IllTypedRecBody (i, na, jl, tys))
 
-let error_not_a_type_loc loc env sigma j =
-  raise_located_type_error (loc, env, sigma, NotAType j)
+let error_not_a_type ?loc env sigma j =
+  raise_type_error ?loc (env, sigma, NotAType j)
 
 (*s Implicit arguments synthesis errors. It is hard to find
     a precise location. *)
@@ -107,15 +107,12 @@ let error_not_a_type_loc loc env sigma j =
 let error_occur_check env sigma ev c =
   raise (PretypeError (env, sigma, UnifOccurCheck (ev,c)))
 
-let error_unsolvable_implicit loc env sigma evk explain =
-  Loc.raise loc
+let error_unsolvable_implicit ?loc env sigma evk explain =
+  Loc.raise ?loc
     (PretypeError (env, sigma, UnsolvableImplicit (evk, explain)))
 
-let error_cannot_unify_loc loc env sigma ?reason (m,n) =
-  Loc.raise loc (PretypeError (env, sigma,CannotUnify (m,n,reason)))
-
-let error_cannot_unify env sigma ?reason (m,n) =
-  raise (PretypeError (env, sigma,CannotUnify (m,n,reason)))
+let error_cannot_unify ?loc env sigma ?reason (m,n) =
+  Loc.raise ?loc (PretypeError (env, sigma,CannotUnify (m,n,reason)))
 
 let error_cannot_unify_local env sigma (m,n,sn) =
   raise (PretypeError (env, sigma,CannotUnifyLocal (m,n,sn)))
@@ -139,21 +136,21 @@ let error_non_linear_unification env sigma hdmeta t =
 
 (*s Ml Case errors *)
 
-let error_cant_find_case_type_loc loc env sigma expr =
-  raise_pretype_error (loc, env, sigma, CantFindCaseType expr)
+let error_cant_find_case_type ?loc env sigma expr =
+  raise_pretype_error ?loc (env, sigma, CantFindCaseType expr)
 
 (*s Pretyping errors *)
 
-let error_unexpected_type_loc loc env sigma actty expty =
-  raise_pretype_error (loc, env, sigma, UnexpectedType (actty, expty))
+let error_unexpected_type ?loc env sigma actty expty =
+  raise_pretype_error ?loc (env, sigma, UnexpectedType (actty, expty))
 
-let error_not_product_loc loc env sigma c =
-  raise_pretype_error (loc, env, sigma, NotProduct c)
+let error_not_product ?loc env sigma c =
+  raise_pretype_error ?loc (env, sigma, NotProduct c)
 
 (*s Error in conversion from AST to glob_constr *)
 
-let error_var_not_found_loc loc s =
-  raise_pretype_error (loc, empty_env, Evd.empty, VarNotFound s)
+let error_var_not_found ?loc s =
+  raise_pretype_error ?loc (empty_env, Evd.empty, VarNotFound s)
 
 (*s Typeclass errors *)
 
@@ -165,7 +162,7 @@ let unsatisfiable_constraints env evd ev comp =
   | Some ev ->
     let loc, kind = Evd.evar_source ev evd in
     let err = UnsatisfiableConstraints (Some (ev, kind), comp) in
-    Loc.raise loc (PretypeError (env,evd,err))
+    Loc.raise ~loc (PretypeError (env,evd,err))
 
 let unsatisfiable_exception exn =
   match exn with
diff --git a/pretyping/pretype_errors.mli b/pretyping/pretype_errors.mli
index f617df9ee..73f81923f 100644
--- a/pretyping/pretype_errors.mli
+++ b/pretyping/pretype_errors.mli
@@ -24,6 +24,7 @@ type unification_error =
   | InstanceNotSameType of existential_key * env * types * types
   | UnifUnivInconsistency of Univ.univ_inconsistency
   | CannotSolveConstraint of Evd.evar_constraint * unification_error
+  | ProblemBeyondCapabilities
 
 type position = (Id.t * Locus.hyp_location_flag) option
 
@@ -63,35 +64,35 @@ exception PretypeError of env * Evd.evar_map * pretype_error
 val precatchable_exception : exn -> bool
 
 (** Raising errors *)
-val error_actual_type_loc :
-  Loc.t -> env -> Evd.evar_map -> unsafe_judgment -> constr ->
+val error_actual_type :
+  ?loc:Loc.t -> env -> Evd.evar_map -> unsafe_judgment -> constr ->
       unification_error -> 'b
 
-val error_cant_apply_not_functional_loc :
-  Loc.t -> env -> Evd.evar_map ->
+val error_cant_apply_not_functional :
+  ?loc:Loc.t -> env -> Evd.evar_map ->
       unsafe_judgment -> unsafe_judgment list -> 'b
 
-val error_cant_apply_bad_type_loc :
-  Loc.t -> env -> Evd.evar_map -> int * constr * constr ->
+val error_cant_apply_bad_type :
+  ?loc:Loc.t -> env -> Evd.evar_map -> int * constr * constr ->
       unsafe_judgment -> unsafe_judgment list -> 'b
 
-val error_case_not_inductive_loc :
-  Loc.t -> env -> Evd.evar_map -> unsafe_judgment -> 'b
+val error_case_not_inductive :
+  ?loc:Loc.t -> env -> Evd.evar_map -> unsafe_judgment -> 'b
 
-val error_ill_formed_branch_loc :
-  Loc.t -> env -> Evd.evar_map ->
+val error_ill_formed_branch :
+  ?loc:Loc.t -> env -> Evd.evar_map ->
       constr -> pconstructor -> constr -> constr -> 'b
 
-val error_number_branches_loc :
-  Loc.t -> env -> Evd.evar_map ->
+val error_number_branches :
+  ?loc:Loc.t -> env -> Evd.evar_map ->
       unsafe_judgment -> int -> 'b
 
-val error_ill_typed_rec_body_loc :
-  Loc.t -> env -> Evd.evar_map ->
+val error_ill_typed_rec_body :
+  ?loc:Loc.t -> env -> Evd.evar_map ->
       int -> Name.t array -> unsafe_judgment array -> types array -> 'b
 
-val error_not_a_type_loc :
-  Loc.t -> env -> Evd.evar_map -> unsafe_judgment -> 'b
+val error_not_a_type :
+  ?loc:Loc.t -> env -> Evd.evar_map -> unsafe_judgment -> 'b
 
 val error_cannot_coerce : env -> Evd.evar_map -> constr * constr -> 'b
 
@@ -100,15 +101,12 @@ val error_cannot_coerce : env -> Evd.evar_map -> constr * constr -> 'b
 val error_occur_check : env -> Evd.evar_map -> existential_key -> constr -> 'b
 
 val error_unsolvable_implicit :
-  Loc.t -> env -> Evd.evar_map -> existential_key ->
+  ?loc:Loc.t -> env -> Evd.evar_map -> existential_key ->
       Evd.unsolvability_explanation option -> 'b
 
-val error_cannot_unify_loc : Loc.t -> env -> Evd.evar_map ->
+val error_cannot_unify : ?loc:Loc.t -> env -> Evd.evar_map ->
   ?reason:unification_error -> constr * constr -> 'b
 
-val error_cannot_unify : env -> Evd.evar_map -> ?reason:unification_error ->
-  constr * constr -> 'b
-
 val error_cannot_unify_local : env -> Evd.evar_map -> constr * constr * constr -> 'b
 
 val error_cannot_find_well_typed_abstraction : env -> Evd.evar_map ->
@@ -125,20 +123,20 @@ val error_non_linear_unification : env -> Evd.evar_map ->
 
 (** {6 Ml Case errors } *)
 
-val error_cant_find_case_type_loc :
-  Loc.t -> env -> Evd.evar_map -> constr -> 'b
+val error_cant_find_case_type :
+  ?loc:Loc.t -> env -> Evd.evar_map -> constr -> 'b
 
 (** {6 Pretyping errors } *)
 
-val error_unexpected_type_loc :
-  Loc.t -> env -> Evd.evar_map -> constr -> constr -> 'b
+val error_unexpected_type :
+  ?loc:Loc.t -> env -> Evd.evar_map -> constr -> constr -> 'b
 
-val error_not_product_loc :
-  Loc.t -> env -> Evd.evar_map -> constr -> 'b
+val error_not_product :
+  ?loc:Loc.t -> env -> Evd.evar_map -> constr -> 'b
 
 (** {6 Error in conversion from AST to glob_constr } *)
 
-val error_var_not_found_loc : Loc.t -> Id.t -> 'b
+val error_var_not_found : ?loc:Loc.t -> Id.t -> 'b
 
 (** {6 Typeclass errors } *)
 
diff --git a/pretyping/pretyping.ml b/pretyping/pretyping.ml
index efc42aab7..f92110ea5 100644
--- a/pretyping/pretyping.ml
+++ b/pretyping/pretyping.ml
@@ -22,7 +22,7 @@
 
 
 open Pp
-open Errors
+open CErrors
 open Util
 open Names
 open Evd
@@ -43,8 +43,10 @@ open Glob_ops
 open Evarconv
 open Pattern
 open Misctypes
+open Tactypes
 open Sigma.Notations
-open Context.Named.Declaration
+
+module NamedDecl = Context.Named.Declaration
 
 type typing_constraint = OfType of types | IsType | WithoutTypeConstraint
 type var_map = constr_under_binders Id.Map.t
@@ -58,8 +60,6 @@ type ltac_var_map = {
 }
 type glob_constr_ltac_closure = ltac_var_map * glob_constr
 type pure_open_constr = evar_map * constr
-type 'a delayed_open =
-  { delayed : 'r. Environ.env -> 'r Sigma.t -> ('a, 'r) Sigma.sigma }
 
 (************************************************************************)
 (* This concerns Cases *)
@@ -68,6 +68,61 @@ open Inductiveops
 
 (************************************************************************)
 
+module ExtraEnv =
+struct
+
+type t = {
+  env : Environ.env;
+  extra : Evarutil.ext_named_context Lazy.t;
+  (** Delay the computation of the evar extended environment *)
+}
+
+let get_extra env =
+  let open Context.Named.Declaration in
+  let ids = List.map get_id (named_context env) in
+  let avoid = List.fold_right Id.Set.add ids Id.Set.empty in
+  Context.Rel.fold_outside push_rel_decl_to_named_context
+    (Environ.rel_context env) ~init:(empty_csubst, [], avoid, named_context env)
+
+let make_env env = { env = env; extra = lazy (get_extra env) }
+let rel_context env = rel_context env.env
+
+let push_rel d env = {
+  env = push_rel d env.env;
+  extra = lazy (push_rel_decl_to_named_context d (Lazy.force env.extra));
+}
+
+let pop_rel_context n env = make_env (pop_rel_context n env.env)
+
+let push_rel_context ctx env = {
+  env = push_rel_context ctx env.env;
+  extra = lazy (List.fold_right push_rel_decl_to_named_context ctx (Lazy.force env.extra));
+}
+
+let lookup_named id env = lookup_named id env.env
+
+let e_new_evar env evdref ?src ?naming typ =
+  let subst2 subst vsubst c = csubst_subst subst (replace_vars vsubst c) in
+  let open Context.Named.Declaration in
+  let inst_vars = List.map (get_id %> mkVar) (named_context env.env) in
+  let inst_rels = List.rev (rel_list 0 (nb_rel env.env)) in
+  let (subst, vsubst, _, nc) = Lazy.force env.extra in
+  let typ' = subst2 subst vsubst typ in
+  let instance = inst_rels @ inst_vars in
+  let sign = val_of_named_context nc in
+  let sigma = Sigma.Unsafe.of_evar_map !evdref in
+  let Sigma (e, sigma, _) = new_evar_instance sign sigma typ' ?src ?naming instance in
+  evdref := Sigma.to_evar_map sigma;
+  e
+
+let push_rec_types (lna,typarray,_) env =
+  let ctxt = Array.map2_i (fun i na t -> Context.Rel.Declaration.LocalAssum (na, lift i t)) lna typarray in
+  Array.fold_left (fun e assum -> push_rel assum e) env ctxt
+
+end
+
+open ExtraEnv
+
 (* An auxiliary function for searching for fixpoint guard indexes *)
 
 exception Found of int array
@@ -81,7 +136,7 @@ let search_guard loc env possible_indexes fixdefs =
     let fix = ((indexes, 0),fixdefs) in
     (try check_fix env fix
      with reraise ->
-       let (e, info) = Errors.push reraise in
+       let (e, info) = CErrors.push reraise in
        let info = Loc.add_loc info loc in
        iraise (e, info));
     indexes
@@ -91,12 +146,21 @@ let search_guard loc env possible_indexes fixdefs =
        List.iter
 	 (fun l ->
 	    let indexes = Array.of_list l in
-	    let fix = ((indexes, 0),fixdefs) in
-	    try check_fix env fix; raise (Found indexes)
+            let fix = ((indexes, 0),fixdefs) in
+            (* spiwack: We search for a unspecified structural
+               argument under the assumption that we need to check the
+               guardedness condition (otherwise the first inductive argument
+               will be chosen). A more robust solution may be to raise an
+               error when totality is assumed but the strutural argument is
+               not specified. *)
+            try
+              let flags = { (typing_flags env) with Declarations.check_guarded = true } in
+              let env = Environ.set_typing_flags flags env in
+              check_fix env fix; raise (Found indexes)
 	    with TypeError _ -> ())
 	 (List.combinations possible_indexes);
        let errmsg = "Cannot guess decreasing argument of fix." in
-	 user_err_loc (loc,"search_guard", Pp.str errmsg)
+	 user_err ~loc ~hdr:"search_guard" (Pp.str errmsg)
      with Found indexes -> indexes)
 
 (* To force universe name declaration before use *)
@@ -124,7 +188,7 @@ let _ =
 						  
 (** Miscellaneous interpretation functions *)
 let interp_universe_level_name evd (loc,s) =
-  let names, _ = Universes.global_universe_names () in
+  let names, _ = Global.global_universe_names () in
     if CString.string_contains s "." then
       match List.rev (CString.split '.' s) with
       | [] -> anomaly (str"Invalid universe name " ++ str s)
@@ -143,12 +207,12 @@ let interp_universe_level_name evd (loc,s) =
       with Not_found ->
 	try 
 	  let id = try Id.of_string s with _ -> raise Not_found in
-	  evd, Idmap.find id names
+          evd, snd (Idmap.find id names)
 	with Not_found -> 
 	  if not (is_strict_universe_declarations ()) then
   	    new_univ_level_variable ~loc ~name:s univ_rigid evd
-	  else user_err_loc (loc, "interp_universe_level_name",
-			     Pp.(str "Undeclared universe: " ++ str s))
+	  else user_err ~loc ~hdr:"interp_universe_level_name"
+			     (Pp.(str "Undeclared universe: " ++ str s))
 
 let interp_universe ?loc evd = function
   | [] -> let evd, l = new_univ_level_variable ?loc univ_rigid evd in
@@ -175,25 +239,34 @@ let interp_elimination_sort = function
   | GSet  -> InSet
   | GType _ -> InType
 
+type inference_hook = env -> evar_map -> evar -> evar_map * constr
+
 type inference_flags = {
   use_typeclasses : bool;
-  use_unif_heuristics : bool;
-  use_hook : (env -> evar_map -> evar -> constr) option;
+  solve_unification_constraints : bool;
+  use_hook : inference_hook option;
   fail_evar : bool;
   expand_evars : bool
 }
 
-let frozen_holes (sigma, sigma') =
-  (); fun ev -> Evar.Map.mem ev (Evd.undefined_map sigma)
-
-let pending_holes (sigma, sigma') =
-  let fold evk _ accu =
-    if not (Evd.mem sigma evk) then Evar.Set.add evk accu else accu
-  in
-  Evd.fold_undefined fold sigma' Evar.Set.empty
+(* Compute the set of still-undefined initial evars up to restriction
+   (e.g. clearing) and the set of yet-unsolved evars freshly created
+   in the extension [sigma'] of [sigma] (excluding the restrictions of
+   the undefined evars of [sigma] to be freshly created evars of
+   [sigma']). Otherwise said, we partition the undefined evars of
+   [sigma'] into those already in [sigma] or deriving from an evar in
+   [sigma] by restriction, and the evars properly created in [sigma'] *)
+
+let frozen_and_pending_holes (sigma, sigma') =
+  let add_derivative_of evk evi acc =
+    match advance sigma' evk with None -> acc | Some evk' -> Evar.Set.add evk' acc in
+  let frozen = Evd.fold_undefined add_derivative_of sigma Evar.Set.empty in
+  let fold evk _ accu = if not (Evar.Set.mem evk frozen) then Evar.Set.add evk accu else accu in
+  let pending = Evd.fold_undefined fold sigma' Evar.Set.empty in
+  (frozen,pending)
 
 let apply_typeclasses env evdref frozen fail_evar =
-  let filter_frozen = frozen in
+  let filter_frozen evk = Evar.Set.mem evk frozen in
   evdref := Typeclasses.resolve_typeclasses
      ~filter:(if Flags.is_program_mode () 
 	      then (fun evk evi -> Typeclasses.no_goals_or_obligations evk evi && not (filter_frozen evk))
@@ -208,7 +281,7 @@ let apply_inference_hook hook evdref pending =
     if Evd.is_undefined sigma evk (* in particular not defined by side-effect *)
     then
       try
-        let c = hook sigma evk in
+        let sigma, c = hook sigma evk in
         Evd.define evk c sigma
       with Exit ->
         sigma
@@ -217,10 +290,10 @@ let apply_inference_hook hook evdref pending =
 
 let apply_heuristics env evdref fail_evar =
   (* Resolve eagerly, potentially making wrong choices *)
-  try evdref := consider_remaining_unif_problems
+  try evdref := solve_unif_constraints_with_heuristics
 	~ts:(Typeclasses.classes_transparent_state ()) env !evdref
-  with e when Errors.noncritical e ->
-    let e = Errors.push e in if fail_evar then iraise e
+  with e when CErrors.noncritical e ->
+    let e = CErrors.push e in if fail_evar then iraise e
 
 let check_typeclasses_instances_are_solved env current_sigma frozen =
   (* Naive way, call resolution again with failure flag *)
@@ -234,7 +307,7 @@ let check_extra_evars_are_solved env current_sigma pending =
 	match k with
 	| Evar_kinds.ImplicitArg (gr, (i, id), false) -> ()
 	| _ ->
-	    error_unsolvable_implicit loc env current_sigma evk None) pending
+	    error_unsolvable_implicit ~loc env current_sigma evk None) pending
 
 (* [check_evars] fails if some unresolved evar remains *)
 
@@ -249,7 +322,7 @@ let check_evars env initial_sigma sigma c =
             let (loc,k) = evar_source evk sigma in
 	      match k with
 	      | Evar_kinds.ImplicitArg (gr, (i, id), false) -> ()
-	      | _ -> Pretype_errors.error_unsolvable_implicit loc env sigma evk None)
+	      | _ -> Pretype_errors.error_unsolvable_implicit ~loc env sigma evk None)
       | _ -> Constr.iter proc_rec c
   in proc_rec c
 
@@ -261,19 +334,17 @@ let check_evars_are_solved env current_sigma frozen pending =
 (* Try typeclasses, hooks, unification heuristics ... *)
 
 let solve_remaining_evars flags env current_sigma pending =
-  let frozen = frozen_holes pending in
-  let pending = pending_holes pending in
+  let frozen,pending = frozen_and_pending_holes pending in
   let evdref = ref current_sigma in
   if flags.use_typeclasses then apply_typeclasses env evdref frozen false;
   if Option.has_some flags.use_hook then
     apply_inference_hook (Option.get flags.use_hook env) evdref pending;
-  if flags.use_unif_heuristics then apply_heuristics env evdref false;
+  if flags.solve_unification_constraints then apply_heuristics env evdref false;
   if flags.fail_evar then check_evars_are_solved env !evdref frozen pending;
   !evdref
 
 let check_evars_are_solved env current_sigma pending =
-  let frozen = frozen_holes pending in
-  let pending = pending_holes pending in
+  let frozen,pending = frozen_and_pending_holes pending in
   check_evars_are_solved env current_sigma frozen pending
 
 let process_inference_flags flags env initial_sigma (sigma,c) =
@@ -284,34 +355,19 @@ let process_inference_flags flags env initial_sigma (sigma,c) =
 (* Allow references to syntactically nonexistent variables (i.e., if applied on an inductive) *)
 let allow_anonymous_refs = ref false
 
-(* 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 evdref lna lar vdefj =
-  let lt = Array.length vdefj in
-    if Int.equal (Array.length lar) lt then
-      for i = 0 to lt-1 do
-        if not (e_cumul env evdref (vdefj.(i)).uj_type
-		  (lift lt lar.(i))) then
-          error_ill_typed_rec_body_loc loc env !evdref
-            i lna vdefj lar
-      done
-
 (* coerce to tycon if any *)
 let inh_conv_coerce_to_tycon resolve_tc loc env evdref j = function
   | None -> j
   | Some t ->
-      evd_comb2 (Coercion.inh_conv_coerce_to resolve_tc loc env) evdref j t
+      evd_comb2 (Coercion.inh_conv_coerce_to resolve_tc loc env.ExtraEnv.env) evdref j t
 
 let check_instance loc subst = function
   | [] -> ()
   | (id,_) :: _ ->
       if List.mem_assoc id subst then
-        user_err_loc (loc,"",pr_id id ++ str "appears more than once.")
+        user_err ~loc  (pr_id id ++ str "appears more than once.")
       else
-        user_err_loc (loc,"",str "No such variable in the signature of the existential variable: " ++ pr_id id ++ str ".")
+        user_err ~loc  (str "No such variable in the signature of the existential variable: " ++ pr_id id ++ str ".")
 
 (* used to enforce a name in Lambda when the type constraints itself
    is named, hence possibly dependent *)
@@ -326,7 +382,7 @@ let ltac_interp_name { ltac_idents ; ltac_genargs } = function
       try Name (Id.Map.find id ltac_idents)
       with Not_found ->
         if Id.Map.mem id ltac_genargs then
-          errorlabstrm "" (str"Ltac variable"++spc()++ pr_id id ++
+          user_err  (str"Ltac variable"++spc()++ pr_id id ++
                            spc()++str"is not bound to an identifier."++spc()++
                            str"It cannot be used in a binder.")
         else n
@@ -339,22 +395,23 @@ let ltac_interp_name_env k0 lvar env =
   (* tail is the part of the env enriched by pretyping *)
   let n = Context.Rel.length (rel_context env) - k0 in
   let ctxt,_ = List.chop n (rel_context env) in
-  let env = pop_rel_context n env in
-  let ctxt = List.map (Context.Rel.Declaration.map_name (ltac_interp_name lvar)) ctxt in
-  push_rel_context ctxt env
+  let open Context.Rel.Declaration in
+  let ctxt' = List.smartmap (map_name (ltac_interp_name lvar)) ctxt in
+  if List.equal (fun d1 d2 -> Name.equal (get_name d1) (get_name d2)) ctxt ctxt' then env
+  else push_rel_context ctxt' (pop_rel_context n env)
 
 let invert_ltac_bound_name lvar env id0 id =
   let id' = Id.Map.find id lvar.ltac_idents in
   try mkRel (pi1 (lookup_rel_id id' (rel_context env)))
   with Not_found ->
-    errorlabstrm "" (str "Ltac variable " ++ pr_id id0 ++
+    user_err  (str "Ltac variable " ++ pr_id id0 ++
 		       str " depends on pattern variable name " ++ pr_id id ++
 		       str " which is not bound in current context.")
 
 let protected_get_type_of env sigma c =
-  try Retyping.get_type_of ~lax:true env sigma c
+  try Retyping.get_type_of ~lax:true env.ExtraEnv.env sigma c
   with Retyping.RetypeError _ ->
-    errorlabstrm ""
+    user_err 
       (str "Cannot reinterpret " ++ quote (print_constr c) ++
        str " in the current environment.")
 
@@ -390,16 +447,16 @@ let pretype_id pretype k0 loc env evdref lvar id =
 	(* and build a nice error message *)
       if Id.Map.mem id lvar.ltac_genargs then begin
         let Geninterp.Val.Dyn (typ, _) = Id.Map.find id lvar.ltac_genargs in
-	user_err_loc (loc,"",
-          str "Variable " ++ pr_id id ++ str " should be bound to a term but is \
+	user_err ~loc 
+         (str "Variable " ++ pr_id id ++ str " should be bound to a term but is \
           bound to a " ++ Geninterp.Val.pr typ ++ str ".")
       end;
       (* Check if [id] is a section or goal variable *)
       try
-	  { uj_val  = mkVar id; uj_type = (get_type (lookup_named id env)) }
+	  { uj_val  = mkVar id; uj_type = NamedDecl.get_type (lookup_named id env) }
       with Not_found ->
 	  (* [id] not found, standard error message *)
-	  error_var_not_found_loc loc id
+	  error_var_not_found ~loc id
 
 let evar_kind_of_term sigma c =
   kind_of_term (whd_evar sigma c)
@@ -422,35 +479,35 @@ let pretype_global loc rigid env evd gr us =
        let arr = Univ.Instance.to_array (Univ.UContext.instance ctx) in
        let len = Array.length arr in
        if len != List.length l then
-	 user_err_loc (loc, "pretype", 
-		       str "Universe instance should have length " ++ int len)
+	 user_err ~loc ~hdr:"pretype"
+		       (str "Universe instance should have length " ++ int len)
        else
 	 let evd, l' = List.fold_left (fun (evd, univs) l -> 
 	    let evd, l = interp_universe_level_name loc evd l in
 	      (evd, l :: univs)) (evd, []) l
 	 in
 	 if List.exists (fun l -> Univ.Level.is_prop l) l' then
-	   user_err_loc (loc, "pretype",
-		 str "Universe instances cannot contain Prop, polymorphic" ++
+	   user_err ~loc ~hdr:"pretype"
+		 (str "Universe instances cannot contain Prop, polymorphic" ++
 		   str " universe instances must be greater or equal to Set.");
 	 evd, Some (Univ.Instance.of_array (Array.of_list (List.rev l')))
   in
-    Evd.fresh_global ~loc ~rigid ?names:instance env evd gr
+    Evd.fresh_global ~loc ~rigid ?names:instance env.ExtraEnv.env evd gr
 
 let pretype_ref loc evdref env ref us =
   match ref with
   | VarRef id ->
       (* Section variable *)
-      (try make_judge (mkVar id) (get_type (lookup_named id env))
+      (try make_judge (mkVar id) (NamedDecl.get_type (lookup_named id env))
        with Not_found ->
          (* This may happen if env is a goal env and section variables have
             been cleared - section variables should be different from goal
             variables *)
-         Pretype_errors.error_var_not_found_loc loc id)
+         Pretype_errors.error_var_not_found ~loc id)
   | ref ->
     let evd, c = pretype_global loc univ_flexible env !evdref ref us in
     let () = evdref := evd in
-    let ty = Typing.unsafe_type_of env evd c in
+    let ty = Typing.unsafe_type_of env.ExtraEnv.env evd c in
       make_judge c ty
 
 let judge_of_Type loc evd s =
@@ -468,7 +525,7 @@ let pretype_sort loc evdref = function
 let new_type_evar env evdref loc =
   let sigma = Sigma.Unsafe.of_evar_map !evdref in
   let Sigma ((e, _), sigma, _) =
-    Evarutil.new_type_evar env sigma
+    Evarutil.new_type_evar env.ExtraEnv.env sigma
       univ_flexible_alg ~src:(loc,Evar_kinds.InternalHole)
   in
   evdref := Sigma.to_evar_map sigma;
@@ -480,7 +537,7 @@ let (f_genarg_interp, genarg_interp_hook) = Hook.make ()
 (* in environment [env], with existential variables [evdref] and *)
 (* the type constraint tycon *)
 
-let rec pretype k0 resolve_tc (tycon : type_constraint) env evdref (lvar : ltac_var_map) t =
+let rec pretype k0 resolve_tc (tycon : type_constraint) (env : ExtraEnv.t) evdref (lvar : ltac_var_map) t =
   let inh_conv_coerce_to_tycon = inh_conv_coerce_to_tycon resolve_tc in
   let pretype_type = pretype_type k0 resolve_tc in
   let pretype = pretype k0 resolve_tc in
@@ -502,11 +559,11 @@ let rec pretype k0 resolve_tc (tycon : type_constraint) env evdref (lvar : ltac_
       let evk =
         try Evd.evar_key id !evdref
         with Not_found ->
-          user_err_loc (loc,"",str "Unknown existential variable.") in
+          user_err ~loc  (str "Unknown existential variable.") in
       let hyps = evar_filtered_context (Evd.find !evdref evk) in
       let args = pretype_instance k0 resolve_tc env evdref lvar loc hyps evk inst in
       let c = mkEvar (evk, args) in
-      let j = (Retyping.get_judgment_of env !evdref c) in
+      let j = (Retyping.get_judgment_of env.ExtraEnv.env !evdref c) in
 	inh_conv_coerce_to_tycon loc env evdref j tycon
 
   | GPatVar (loc,(someta,n)) ->
@@ -535,7 +592,7 @@ let rec pretype k0 resolve_tc (tycon : type_constraint) env evdref (lvar : ltac_
         | None ->
           new_type_evar env evdref loc in
       let ist = lvar.ltac_genargs in
-      let (c, sigma) = Hook.get f_genarg_interp ty env !evdref ist arg in
+      let (c, sigma) = Hook.get f_genarg_interp ty env.ExtraEnv.env !evdref ist arg in
       let () = evdref := sigma in
       { uj_val = c; uj_type = ty }
 
@@ -569,7 +626,7 @@ let rec pretype k0 resolve_tc (tycon : type_constraint) env evdref (lvar : ltac_
  	let fixi = match fixkind with
 	  | GFix (vn,i) -> i
 	  | GCoFix i -> i
-	in e_conv env evdref ftys.(fixi) t
+	in e_conv env.ExtraEnv.env evdref ftys.(fixi) t
       | None -> true
     in
       (* Note: bodies are not used by push_rec_types, so [||] is safe *)
@@ -587,7 +644,7 @@ let rec pretype k0 resolve_tc (tycon : type_constraint) env evdref (lvar : ltac_
 	    { 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 evdref names ftys vdefj;
+      Typing.check_type_fixpoint loc env.ExtraEnv.env evdref names ftys vdefj;
       let ftys = Array.map (nf_evar !evdref) ftys in
       let fdefs = Array.map (fun x -> nf_evar !evdref (j_val x)) vdefj in
       let fixj = match fixkind with
@@ -606,13 +663,16 @@ let rec pretype k0 resolve_tc (tycon : type_constraint) env evdref (lvar : ltac_
 			     vn)
 	  in
 	  let fixdecls = (names,ftys,fdefs) in
-	  let indexes = search_guard loc env possible_indexes fixdecls in
+          let indexes =
+            search_guard
+              loc env.ExtraEnv.env possible_indexes fixdecls
+          in
 	    make_judge (mkFix ((indexes,i),fixdecls)) ftys.(i)
 	| GCoFix i ->
 	  let cofix = (i,(names,ftys,fdefs)) in
-	    (try check_cofix env cofix
+            (try check_cofix env.ExtraEnv.env cofix
              with reraise ->
-               let (e, info) = Errors.push reraise in
+               let (e, info) = CErrors.push reraise in
                let info = Loc.add_loc info loc in
                iraise (e, info));
 	    make_judge (mkCoFix cofix) ftys.(i)
@@ -640,7 +700,7 @@ let rec pretype k0 resolve_tc (tycon : type_constraint) env evdref (lvar : ltac_
 	    if Int.equal npars 0 then []
 	    else
 	      try
-	  	let IndType (indf, args) = find_rectype env !evdref ty in
+	  	let IndType (indf, args) = find_rectype env.ExtraEnv.env !evdref ty in
 	  	let ((ind',u'),pars) = dest_ind_family indf in
 	  	  if eq_ind ind ind' then pars
 	  	  else (* Let the usual code throw an error *) []
@@ -649,9 +709,9 @@ let rec pretype k0 resolve_tc (tycon : type_constraint) env evdref (lvar : ltac_
     in
     let app_f = 
       match kind_of_term fj.uj_val with
-      | Const (p, u) when Environ.is_projection p env ->
+      | Const (p, u) when Environ.is_projection p env.ExtraEnv.env ->
 	let p = Projection.make p false in
-	let pb = Environ.lookup_projection p env in
+	let pb = Environ.lookup_projection p env.ExtraEnv.env in
 	let npars = pb.Declarations.proj_npars in
 	  fun n -> 
 	    if n == npars + 1 then fun _ v -> mkProj (p, v)
@@ -662,8 +722,8 @@ let rec pretype k0 resolve_tc (tycon : type_constraint) env evdref (lvar : ltac_
       | [] -> resj
       | c::rest ->
 	let argloc = loc_of_glob_constr c in
-	let resj = evd_comb1 (Coercion.inh_app_fun resolve_tc env) evdref resj in
-        let resty = whd_betadeltaiota env !evdref resj.uj_type in
+	let resj = evd_comb1 (Coercion.inh_app_fun resolve_tc env.ExtraEnv.env) evdref resj in
+        let resty = whd_all env.ExtraEnv.env !evdref resj.uj_type in
       	  match kind_of_term resty with
 	  | Prod (na,c1,c2) ->
 	    let tycon = Some c1 in
@@ -672,7 +732,7 @@ let rec pretype k0 resolve_tc (tycon : type_constraint) env evdref (lvar : ltac_
 	      match candargs with
 	      | [] -> [], j_val hj
 	      | arg :: args -> 
-		if e_conv env evdref (j_val hj) arg then
+		if e_conv env.ExtraEnv.env evdref (j_val hj) arg then
 		  args, nf_evar !evdref (j_val hj)
 		else [], j_val hj
 	    in
@@ -682,22 +742,22 @@ let rec pretype k0 resolve_tc (tycon : type_constraint) env evdref (lvar : ltac_
 		
 	  | _ ->
 	    let hj = pretype empty_tycon env evdref lvar c in
-	      error_cant_apply_not_functional_loc
-		(Loc.merge floc argloc) env !evdref
-	      	resj [hj]
+	      error_cant_apply_not_functional
+                ~loc:(Loc.merge floc argloc) env.ExtraEnv.env !evdref
+                resj [hj]
     in
     let resj = apply_rec env 1 fj candargs args in
     let resj =
       match evar_kind_of_term !evdref resj.uj_val with
       | App (f,args) ->
         let f = whd_evar !evdref f in
-          if is_template_polymorphic env f then
+          if is_template_polymorphic env.ExtraEnv.env f then
 	    (* Special case for inductive type applications that must be 
 	       refreshed right away. *)
 	    let sigma = !evdref in
 	    let c = mkApp (f,Array.map (whd_evar sigma) args) in
-	    let c = evd_comb1 (Evarsolve.refresh_universes (Some true) env) evdref c in
-	    let t = Retyping.get_type_of env !evdref c in
+	    let c = evd_comb1 (Evarsolve.refresh_universes (Some true) env.ExtraEnv.env) evdref c in
+	    let t = Retyping.get_type_of env.ExtraEnv.env !evdref c in
 	      make_judge c (* use this for keeping evars: resj.uj_val *) t
 	  else resj
       | _ -> resj 
@@ -710,11 +770,11 @@ let rec pretype k0 resolve_tc (tycon : type_constraint) env evdref (lvar : ltac_
 	match tycon with
 	| None -> evd, tycon
 	| Some ty ->
-	  let evd, ty' = Coercion.inh_coerce_to_prod loc env evd ty in
+	  let evd, ty' = Coercion.inh_coerce_to_prod loc env.ExtraEnv.env evd ty in
 	    evd, Some ty')
       evdref tycon
     in
-    let (name',dom,rng) = evd_comb1 (split_tycon loc env) evdref tycon' in
+    let (name',dom,rng) = evd_comb1 (split_tycon loc env.ExtraEnv.env) evdref tycon' in
     let dom_valcon = valcon_of_tycon dom in
     let j = pretype_type dom_valcon env evdref lvar c1 in
     (* The name specified by ltac is used also to create bindings. So
@@ -723,7 +783,7 @@ let rec pretype k0 resolve_tc (tycon : type_constraint) env evdref (lvar : ltac_
     let var = LocalAssum (name, j.utj_val) in
     let j' = pretype rng (push_rel var env) evdref lvar c2 in
     let name = ltac_interp_name lvar name in
-    let resj = judge_of_abstraction env (orelse_name name name') j j' in
+    let resj = judge_of_abstraction env.ExtraEnv.env (orelse_name name name') j j' in
       inh_conv_coerce_to_tycon loc env evdref resj tycon
 
   | GProd(loc,name,bk,c1,c2)        ->
@@ -736,16 +796,16 @@ let rec pretype k0 resolve_tc (tycon : type_constraint) env evdref (lvar : ltac_
         let j = pretype_type empty_valcon env evdref lvar c2 in
           { j with utj_val = lift 1 j.utj_val }
       | Name _ ->
-        let var = (name,j.utj_val) in
-        let env' = push_rel_assum var env in
+        let var = LocalAssum (name, j.utj_val) in
+        let env' = push_rel var env in
           pretype_type empty_valcon env' evdref lvar c2
     in
     let name = ltac_interp_name lvar name in
     let resj =
       try
-        judge_of_product env name j j'
+        judge_of_product env.ExtraEnv.env name j j'
       with TypeError _ as e ->
-        let (e, info) = Errors.push e in
+        let (e, info) = CErrors.push e in
         let info = Loc.add_loc info loc in
         iraise (e, info) in
       inh_conv_coerce_to_tycon loc env evdref resj tycon
@@ -759,7 +819,7 @@ let rec pretype k0 resolve_tc (tycon : type_constraint) env evdref (lvar : ltac_
       | _ -> pretype empty_tycon env evdref lvar c1
     in
     let t = evd_comb1 (Evarsolve.refresh_universes
-      ~onlyalg:true ~status:Evd.univ_flexible (Some false) env)
+      ~onlyalg:true ~status:Evd.univ_flexible (Some false) env.ExtraEnv.env)
       evdref j.uj_type in
     (* The name specified by ltac is used also to create bindings. So
        the substitution must also be applied on variables before they are
@@ -774,21 +834,21 @@ let rec pretype k0 resolve_tc (tycon : type_constraint) env evdref (lvar : ltac_
   | GLetTuple (loc,nal,(na,po),c,d) ->
     let cj = pretype empty_tycon env evdref lvar c in
     let (IndType (indf,realargs)) =
-      try find_rectype env !evdref cj.uj_type
+      try find_rectype env.ExtraEnv.env !evdref cj.uj_type
       with Not_found ->
 	let cloc = loc_of_glob_constr c in
-	  error_case_not_inductive_loc cloc env !evdref cj
+	  error_case_not_inductive ~loc:cloc env.ExtraEnv.env !evdref cj
     in
-    let cstrs = get_constructors env indf in
+    let cstrs = get_constructors env.ExtraEnv.env indf in
     if not (Int.equal (Array.length cstrs) 1) then
-      user_err_loc (loc,"",str "Destructing let is only for inductive types" ++
+      user_err ~loc  (str "Destructing let is only for inductive types" ++
 	str " with one constructor.");
     let cs = cstrs.(0) in
     if not (Int.equal (List.length nal) cs.cs_nargs) then
-      user_err_loc (loc,"", str "Destructing let on this type expects " ++ 
+      user_err ~loc:loc (str "Destructing let on this type expects " ++ 
 	int cs.cs_nargs ++ str " variables.");
     let fsign, record = 
-      match get_projections env indf with
+      match get_projections env.ExtraEnv.env indf with
       | None ->
 	 List.map2 set_name (List.rev nal) cs.cs_args, false
       | Some ps ->
@@ -809,36 +869,36 @@ let rec pretype k0 resolve_tc (tycon : type_constraint) env evdref (lvar : ltac_
         let nal = List.rev nal in
         let fsign = List.map2 set_name nal fsign in
 	let f = it_mkLambda_or_LetIn f fsign in
-	let ci = make_case_info env (fst ind) LetStyle in
+	let ci = make_case_info env.ExtraEnv.env (fst ind) LetStyle in
 	  mkCase (ci, p, cj.uj_val,[|f|]) 
       else it_mkLambda_or_LetIn f fsign
     in
     let env_f = push_rel_context fsign env in
       (* Make dependencies from arity signature impossible *)
     let arsgn =
-      let arsgn,_ = get_arity env indf in
+      let arsgn,_ = get_arity env.ExtraEnv.env indf in
 	if not !allow_anonymous_refs then
 	  List.map (set_name Anonymous) arsgn
 	else arsgn
     in
-      let psign = LocalAssum (na, build_dependent_inductive env indf) :: arsgn in
+      let psign = LocalAssum (na, build_dependent_inductive env.ExtraEnv.env indf) :: arsgn in
       let nar = List.length arsgn in
 	  (match po with
 	  | Some p ->
 	    let env_p = push_rel_context psign env in
 	    let pj = pretype_type empty_valcon env_p evdref lvar p in
 	    let ccl = nf_evar !evdref pj.utj_val in
-	    let psign = make_arity_signature env true indf in (* with names *)
+	    let psign = make_arity_signature env.ExtraEnv.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 !evdref lp inst in
+	    let fty = hnf_lam_applist env.ExtraEnv.env !evdref lp inst in
 	    let fj = pretype (mk_tycon fty) env_f evdref lvar d in
 	    let v =
 	      let ind,_ = dest_ind_family indf in
-		Typing.check_allowed_sort env !evdref ind cj.uj_val p;
+		Typing.check_allowed_sort env.ExtraEnv.env !evdref ind cj.uj_val p;
 		obj ind p cj.uj_val fj.uj_val
 	    in
 	      { uj_val = v; uj_type = substl (realargs@[cj.uj_val]) ccl }
@@ -851,37 +911,37 @@ let rec pretype k0 resolve_tc (tycon : type_constraint) env evdref (lvar : ltac_
 	      if noccur_between 1 cs.cs_nargs ccl then
 		lift (- cs.cs_nargs) ccl
 	      else
-		error_cant_find_case_type_loc loc env !evdref
+		error_cant_find_case_type ~loc env.ExtraEnv.env !evdref
 		  cj.uj_val in
 		 (* let ccl = refresh_universes ccl in *)
 	    let p = it_mkLambda_or_LetIn (lift (nar+1) ccl) psign in
 	    let v =
 	      let ind,_ = dest_ind_family indf in
-		Typing.check_allowed_sort env !evdref ind cj.uj_val p;
+		Typing.check_allowed_sort env.ExtraEnv.env !evdref ind cj.uj_val p;
 		obj ind p cj.uj_val fj.uj_val
 	    in { uj_val = v; uj_type = ccl })
 
   | GIf (loc,c,(na,po),b1,b2) ->
     let cj = pretype empty_tycon env evdref lvar c in
     let (IndType (indf,realargs)) =
-      try find_rectype env !evdref cj.uj_type
+      try find_rectype env.ExtraEnv.env !evdref cj.uj_type
       with Not_found ->
 	let cloc = loc_of_glob_constr c in
-	  error_case_not_inductive_loc cloc env !evdref cj in
-    let cstrs = get_constructors env indf in
+	  error_case_not_inductive ~loc:cloc env.ExtraEnv.env !evdref cj in
+    let cstrs = get_constructors env.ExtraEnv.env indf in
       if not (Int.equal (Array.length cstrs) 2) then
-        user_err_loc (loc,"",
-		      str "If is only for inductive types with two constructors.");
+        user_err ~loc 
+		      (str "If is only for inductive types with two constructors.");
 
       let arsgn =
-	let arsgn,_ = get_arity env indf in
+	let arsgn,_ = get_arity env.ExtraEnv.env indf in
 	  if not !allow_anonymous_refs then
 	      (* Make dependencies from arity signature impossible *)
 	    List.map (set_name Anonymous) arsgn
 	  else arsgn
       in
       let nar = List.length arsgn in
-      let psign = LocalAssum (na, build_dependent_inductive env indf) :: arsgn in
+      let psign = LocalAssum (na, build_dependent_inductive env.ExtraEnv.env indf) :: arsgn in
       let pred,p = match po with
 	| Some p ->
 	  let env_p = push_rel_context psign env in
@@ -919,9 +979,9 @@ let rec pretype k0 resolve_tc (tycon : type_constraint) env evdref (lvar : ltac_
       let b2 = f cstrs.(1) b2 in
       let v =
 	let ind,_ = dest_ind_family indf in
-	let ci = make_case_info env (fst ind) IfStyle in
+	let ci = make_case_info env.ExtraEnv.env (fst ind) IfStyle in
 	let pred = nf_evar !evdref pred in
-	  Typing.check_allowed_sort env !evdref ind cj.uj_val pred;
+	  Typing.check_allowed_sort env.ExtraEnv.env !evdref ind cj.uj_val pred;
 	  mkCase (ci, pred, cj.uj_val, [|b1;b2|])
       in
       let cj = { uj_val = v; uj_type = p } in
@@ -929,43 +989,46 @@ let rec pretype k0 resolve_tc (tycon : type_constraint) env evdref (lvar : ltac_
 
   | GCases (loc,sty,po,tml,eqns) ->
     Cases.compile_cases loc sty
-      ((fun vtyc env evdref -> pretype vtyc env evdref lvar),evdref)
-      tycon env (* loc *) (po,tml,eqns)
+      ((fun vtyc env evdref -> pretype vtyc (make_env env) evdref lvar),evdref)
+      tycon env.ExtraEnv.env (* loc *) (po,tml,eqns)
 
   | GCast (loc,c,k) ->
     let cj =
       match k with
       | CastCoerce ->
 	let cj = pretype empty_tycon env evdref lvar c in
-	  evd_comb1 (Coercion.inh_coerce_to_base loc env) evdref cj
+	  evd_comb1 (Coercion.inh_coerce_to_base loc env.ExtraEnv.env) evdref cj
       | CastConv t | CastVM t | CastNative t ->
 	let k = (match k with CastVM _ -> VMcast | CastNative _ -> NATIVEcast | _ -> DEFAULTcast) in
 	let tj = pretype_type empty_valcon env evdref lvar t in
-	let tval = nf_evar !evdref tj.utj_val in
-	let cj = match k with
+        let tval = evd_comb1 (Evarsolve.refresh_universes
+                             ~onlyalg:true ~status:Evd.univ_flexible (Some false) env.ExtraEnv.env)
+                          evdref tj.utj_val in
+	let tval = nf_evar !evdref tval in
+	let cj, tval = match k with
 	  | VMcast ->
  	    let cj = pretype empty_tycon env evdref lvar c in
-	    let cty = nf_evar !evdref cj.uj_type and tval = nf_evar !evdref tj.utj_val in
+	    let cty = nf_evar !evdref cj.uj_type and tval = nf_evar !evdref tval in
 	      if not (occur_existential cty || occur_existential tval) then
-		let (evd,b) = Reductionops.vm_infer_conv env !evdref cty tval in
-		if b then (evdref := evd; cj)
+		let (evd,b) = Reductionops.vm_infer_conv env.ExtraEnv.env !evdref cty tval in
+		if b then (evdref := evd; cj, tval)
 		else
-		  error_actual_type_loc loc env !evdref cj tval 
-                      (ConversionFailed (env,cty,tval))
-	      else user_err_loc (loc,"",str "Cannot check cast with vm: " ++
+		  error_actual_type ~loc env.ExtraEnv.env !evdref cj tval 
+                      (ConversionFailed (env.ExtraEnv.env,cty,tval))
+	      else user_err ~loc  (str "Cannot check cast with vm: " ++
 		str "unresolved arguments remain.")
 	  | NATIVEcast ->
  	    let cj = pretype empty_tycon env evdref lvar c in
-	    let cty = nf_evar !evdref cj.uj_type and tval = nf_evar !evdref tj.utj_val in
+	    let cty = nf_evar !evdref cj.uj_type and tval = nf_evar !evdref tval in
             begin
-	      let (evd,b) = Nativenorm.native_infer_conv env !evdref cty tval in
-	      if b then (evdref := evd; cj)
+	      let (evd,b) = Nativenorm.native_infer_conv env.ExtraEnv.env !evdref cty tval in
+	      if b then (evdref := evd; cj, tval)
 	      else
-                error_actual_type_loc loc env !evdref cj tval 
-                  (ConversionFailed (env,cty,tval))
+                error_actual_type ~loc env.ExtraEnv.env !evdref cj tval
+                  (ConversionFailed (env.ExtraEnv.env,cty,tval))
             end
 	  | _ -> 
- 	    pretype (mk_tycon tval) env evdref lvar c
+ 	    pretype (mk_tycon tval) env evdref lvar c, tval
 	in
 	let v = mkCast (cj.uj_val, k, tval) in
 	  { uj_val = v; uj_type = tval }
@@ -973,8 +1036,8 @@ let rec pretype k0 resolve_tc (tycon : type_constraint) env evdref (lvar : ltac_
 
 and pretype_instance k0 resolve_tc env evdref lvar loc hyps evk update =
   let f decl (subst,update) =
-    let id = get_id decl in
-    let t = replace_vars subst (get_type decl) in
+    let id = NamedDecl.get_id decl in
+    let t = replace_vars subst (NamedDecl.get_type decl) in
     let c, update =
       try
         let c = List.assoc id update in
@@ -983,13 +1046,13 @@ and pretype_instance k0 resolve_tc env evdref lvar loc hyps evk update =
       with Not_found ->
       try
         let (n,_,t') = lookup_rel_id id (rel_context env) in
-        if is_conv env !evdref t t' then mkRel n, update else raise Not_found
+        if is_conv env.ExtraEnv.env !evdref t t' then mkRel n, update else raise Not_found
       with Not_found ->
       try
-        let t' = lookup_named id env |> get_type in
-        if is_conv env !evdref t t' then mkVar id, update else raise Not_found
+        let t' = env |> lookup_named id |> NamedDecl.get_type in
+        if is_conv env.ExtraEnv.env !evdref t t' then mkVar id, update else raise Not_found
       with Not_found ->
-        user_err_loc (loc,"",str "Cannot interpret " ++
+        user_err ~loc  (str "Cannot interpret " ++
           pr_existential_key !evdref evk ++
           str " in current context: no binding for " ++ pr_id id ++ str ".") in
     ((id,c)::subst, update) in
@@ -998,17 +1061,17 @@ and pretype_instance k0 resolve_tc env evdref lvar loc hyps evk update =
   Array.map_of_list snd subst
 
 (* [pretype_type valcon env evdref lvar c] coerces [c] into a type *)
-and pretype_type k0 resolve_tc valcon env evdref lvar = function
+and pretype_type k0 resolve_tc valcon (env : ExtraEnv.t) evdref lvar = function
   | GHole (loc, knd, naming, None) ->
       (match valcon with
        | Some v ->
            let s =
 	     let sigma =  !evdref in
-	     let t = Retyping.get_type_of env sigma v in
-	       match kind_of_term (whd_betadeltaiota env sigma t) with
+	     let t = Retyping.get_type_of env.ExtraEnv.env sigma v in
+	       match kind_of_term (whd_all env.ExtraEnv.env sigma t) with
                | Sort s -> s
                | Evar ev when is_Type (existential_type sigma ev) ->
-		   evd_comb1 (define_evar_as_sort env) evdref ev
+		   evd_comb1 (define_evar_as_sort env.ExtraEnv.env) evdref ev
                | _ -> anomaly (Pp.str "Found a type constraint which is not a type")
            in
 	     { utj_val = v;
@@ -1021,16 +1084,17 @@ and pretype_type k0 resolve_tc valcon env evdref lvar = function
   | c ->
       let j = pretype k0 resolve_tc empty_tycon env evdref lvar c in
       let loc = loc_of_glob_constr c in
-      let tj = evd_comb1 (Coercion.inh_coerce_to_sort loc env) evdref j in
+      let tj = evd_comb1 (Coercion.inh_coerce_to_sort loc env.ExtraEnv.env) evdref j in
 	match valcon with
 	| None -> tj
 	| Some v ->
-	    if e_cumul env evdref v tj.utj_val then tj
+	    if e_cumul env.ExtraEnv.env evdref v tj.utj_val then tj
 	    else
-	      error_unexpected_type_loc
-                (loc_of_glob_constr c) env !evdref tj.utj_val v
+	      error_unexpected_type
+                ~loc:(loc_of_glob_constr c) env.ExtraEnv.env !evdref tj.utj_val v
 
 let ise_pretype_gen flags env sigma lvar kind c =
+  let env = make_env env in
   let evdref = ref sigma in
   let k0 = Context.Rel.length (rel_context env) in
   let c' = match kind with
@@ -1041,18 +1105,18 @@ let ise_pretype_gen flags env sigma lvar kind c =
     | IsType ->
 	(pretype_type k0 flags.use_typeclasses empty_valcon env evdref lvar c).utj_val 
   in
-  process_inference_flags flags env sigma (!evdref,c')
+  process_inference_flags flags env.ExtraEnv.env sigma (!evdref,c')
 
 let default_inference_flags fail = {
   use_typeclasses = true;
-  use_unif_heuristics = true;
+  solve_unification_constraints = true;
   use_hook = None;
   fail_evar = fail;
   expand_evars = true }
 
 let no_classes_no_fail_inference_flags = {
   use_typeclasses = false;
-  use_unif_heuristics = true;
+  solve_unification_constraints = true;
   use_hook = None;
   fail_evar = false;
   expand_evars = true }
@@ -1073,19 +1137,21 @@ let on_judgment f j =
   {uj_val = c; uj_type = t}
 
 let understand_judgment env sigma c =
+  let env = make_env env in
   let evdref = ref sigma in
   let k0 = Context.Rel.length (rel_context env) in
   let j = pretype k0 true empty_tycon env evdref empty_lvar c in
   let j = on_judgment (fun c ->
-    let evd, c = process_inference_flags all_and_fail_flags env sigma (!evdref,c) in 
+    let evd, c = process_inference_flags all_and_fail_flags env.ExtraEnv.env sigma (!evdref,c) in 
       evdref := evd; c) j
   in j, Evd.evar_universe_context !evdref
 
 let understand_judgment_tcc env evdref c =
+  let env = make_env env in
   let k0 = Context.Rel.length (rel_context env) in
   let j = pretype k0 true empty_tycon env evdref empty_lvar c in
   on_judgment (fun c ->
-    let (evd,c) = process_inference_flags all_no_fail_flags env Evd.empty (!evdref,c) in
+    let (evd,c) = process_inference_flags all_no_fail_flags env.ExtraEnv.env Evd.empty (!evdref,c) in
     evdref := evd; c) j
 
 let ise_pretype_gen_ctx flags env sigma lvar kind c =
@@ -1114,7 +1180,7 @@ let understand_ltac flags env sigma lvar kind c =
 
 let constr_flags = {
   use_typeclasses = true;
-  use_unif_heuristics = true;
+  solve_unification_constraints = true;
   use_hook = None;
   fail_evar = true;
   expand_evars = true }
@@ -1134,3 +1200,9 @@ let type_uconstr ?(flags = constr_flags)
   let (sigma, c) = understand_ltac flags env sigma vars expected_type term in
   Sigma.Unsafe.of_pair (c, sigma)
   end }
+
+let pretype k0 resolve_tc typcon env evdref lvar t =
+  pretype k0 resolve_tc typcon (make_env env) evdref lvar t
+
+let pretype_type k0 resolve_tc valcon env evdref lvar t =
+  pretype_type k0 resolve_tc valcon (make_env env) evdref lvar t
diff --git a/pretyping/pretyping.mli b/pretyping/pretyping.mli
index 824bb11aa..2c6aa7a21 100644
--- a/pretyping/pretyping.mli
+++ b/pretyping/pretyping.mli
@@ -47,17 +47,16 @@ val empty_lvar : ltac_var_map
 type glob_constr_ltac_closure = ltac_var_map * glob_constr
 type pure_open_constr = evar_map * constr
 
+type inference_hook = env -> evar_map -> evar -> evar_map * constr
+
 type inference_flags = {
   use_typeclasses : bool;
-  use_unif_heuristics : bool;
-  use_hook : (env -> evar_map -> evar -> constr) option;
+  solve_unification_constraints : bool;
+  use_hook : inference_hook option;
   fail_evar : bool;
   expand_evars : bool
 }
 
-type 'a delayed_open =
-  { delayed : 'r. Environ.env -> 'r Sigma.t -> ('a, 'r) Sigma.sigma }
-
 val default_inference_flags : bool -> inference_flags
 
 val no_classes_no_fail_inference_flags : inference_flags
@@ -120,7 +119,7 @@ val understand_judgment_tcc : env -> evar_map ref ->
 val type_uconstr :
   ?flags:inference_flags ->
   ?expected_type:typing_constraint ->
-  Geninterp.interp_sign -> Glob_term.closed_glob_constr -> constr delayed_open
+  Geninterp.interp_sign -> Glob_term.closed_glob_constr -> constr Tactypes.delayed_open
 
 (** Trying to solve remaining evars and remaining conversion problems
     possibly using type classes, heuristics, external tactic solver
diff --git a/pretyping/program.ml b/pretyping/program.ml
index 0bd121f6f..4b6137b53 100644
--- a/pretyping/program.ml
+++ b/pretyping/program.ml
@@ -7,7 +7,7 @@
 (************************************************************************)
 
 open Pp
-open Errors
+open CErrors
 open Util
 open Names
 open Term
@@ -15,10 +15,12 @@ open Term
 let make_dir l = DirPath.make (List.rev_map Id.of_string l)
 
 let find_reference locstr dir s =
-  let sp = Libnames.make_path (make_dir dir) (Id.of_string s) in
+  let dp = make_dir dir in
+  let sp = Libnames.make_path dp (Id.of_string s) in
   try Nametab.global_of_path sp
   with Not_found ->
-    anomaly ~label:locstr (Pp.str "cannot find" ++ spc () ++ Libnames.pr_path sp)
+    user_err (str "Library " ++ Libnames.pr_dirpath dp ++
+      str " has to be required first.")
 
 let coq_reference locstr dir s = find_reference locstr ("Coq"::dir) s
 let coq_constant locstr dir s = Universes.constr_of_global (coq_reference locstr dir s)
@@ -67,3 +69,43 @@ let mk_coq_and l =
       (fun c conj ->
 	 mkApp (and_typ, [| c ; conj |]))
       l
+
+(* true = transparent by default, false = opaque if possible *)
+let proofs_transparency = ref true
+let program_cases = ref true
+let program_generalized_coercion = ref true
+
+let set_proofs_transparency = (:=) proofs_transparency
+let get_proofs_transparency () = !proofs_transparency
+
+let is_program_generalized_coercion () = !program_generalized_coercion
+let is_program_cases () = !program_cases
+
+open Goptions
+
+let _ =
+  declare_bool_option
+  { optsync  = true;
+    optdepr  = false;
+    optname  = "preferred transparency of Program obligations";
+    optkey   = ["Transparent";"Obligations"];
+    optread  = get_proofs_transparency;
+    optwrite = set_proofs_transparency; }
+
+let _ =
+  declare_bool_option
+  { optsync  = true;
+    optdepr  = false;
+    optname  = "program cases";
+    optkey   = ["Program";"Cases"];
+    optread  = (fun () -> !program_cases);
+    optwrite = (:=) program_cases }
+
+let _ =
+  declare_bool_option
+  { optsync  = true;
+    optdepr  = false;
+    optname  = "program generalized coercion";
+    optkey   = ["Program";"Generalized";"Coercion"];
+    optread  = (fun () -> !program_generalized_coercion);
+    optwrite = (:=) program_generalized_coercion }
diff --git a/pretyping/program.mli b/pretyping/program.mli
index b7ebcbc95..023ff8ca5 100644
--- a/pretyping/program.mli
+++ b/pretyping/program.mli
@@ -37,3 +37,7 @@ val mk_coq_not : constr -> constr
 
 (** Polymorphic application of delayed references *)
 val papp : Evd.evar_map ref -> (unit -> global_reference) -> constr array -> constr
+
+val get_proofs_transparency : unit -> bool
+val is_program_cases : unit -> bool
+val is_program_generalized_coercion : unit -> bool
diff --git a/pretyping/recordops.ml b/pretyping/recordops.ml
index bbb6a9266..cda052b79 100644
--- a/pretyping/recordops.ml
+++ b/pretyping/recordops.ml
@@ -13,7 +13,7 @@
 (* This file registers properties of records: projections and
    canonical structures *)
 
-open Errors
+open CErrors
 open Util
 open Pp
 open Names
@@ -176,7 +176,7 @@ let cs_pattern_of_constr t =
       App (f,vargs) ->
 	begin
 	  try Const_cs (global_of_constr f) , None, Array.to_list vargs
-          with e when Errors.noncritical e -> raise Not_found
+          with e when CErrors.noncritical e -> raise Not_found
 	end
     | Rel n -> Default_cs, Some n, []
     | Prod (_,a,b) when not (Termops.dependent (mkRel 1) b) -> Prod_cs, None, [a; Termops.pop b]
@@ -184,11 +184,18 @@ let cs_pattern_of_constr t =
     | _ ->
 	begin
 	  try Const_cs (global_of_constr t) , None, []
-          with e when Errors.noncritical e -> raise Not_found
+          with e when CErrors.noncritical e -> raise Not_found
 	end
 
+let warn_projection_no_head_constant =
+  CWarnings.create ~name:"projection-no-head-constant" ~category:"typechecker"
+         (fun (t,con_pp,proji_sp_pp) ->
+          strbrk "Projection value has no head constant: "
+          ++ Termops.print_constr t ++ strbrk " in canonical instance "  
+          ++ con_pp ++ str " of " ++ proji_sp_pp ++ strbrk ", ignoring it.")
+
 (* Intended to always succeed *)
-let compute_canonical_projections (con,ind) =
+let compute_canonical_projections warn (con,ind) =
   let env = Global.env () in
   let ctx = Univ.instantiate_univ_context (Environ.constant_context env con) in
   let u = Univ.UContext.instance ctx in
@@ -213,13 +220,10 @@ let compute_canonical_projections (con,ind) =
 		   let patt, n , args = cs_pattern_of_constr t in
 		     ((ConstRef proji_sp, patt, t, n, args) :: l)
 		 with Not_found ->
-                   if Flags.is_verbose () then
-                     (let con_pp = Nametab.pr_global_env Id.Set.empty (ConstRef con)
+                     let con_pp = Nametab.pr_global_env Id.Set.empty (ConstRef con)
                       and proji_sp_pp = Nametab.pr_global_env Id.Set.empty (ConstRef proji_sp) in
-		      Feedback.msg_warning (strbrk "No global reference exists for projection value"
-                                   ++ Termops.print_constr t ++ strbrk " in instance "  
-                                   ++ con_pp ++ str " of " ++ proji_sp_pp ++ strbrk ", ignoring it."));
-		   l
+                     if warn then warn_projection_no_head_constant (t,con_pp,proji_sp_pp);
+                   l
 	       end
 	   | _ -> l)
       [] lps in
@@ -235,9 +239,15 @@ let pr_cs_pattern = function
   | Default_cs -> str "_"
   | Sort_cs s -> Termops.pr_sort_family s
 
-let open_canonical_structure i (_,o) =
-  if Int.equal i 1 then
-    let lo = compute_canonical_projections o in
+let warn_redundant_canonical_projection =
+  CWarnings.create ~name:"redundant-canonical-projection" ~category:"typechecker"
+         (fun (hd_val,prj,new_can_s,old_can_s) ->
+          strbrk "Ignoring canonical projection to " ++ hd_val
+          ++ strbrk " by " ++ prj ++ strbrk " in "
+          ++ new_can_s ++ strbrk ": redundant with " ++ old_can_s)
+
+let add_canonical_structure warn o =
+    let lo = compute_canonical_projections warn o in
     List.iter (fun ((proj,(cs_pat,_ as pat)),s) ->
       let l = try Refmap.find proj !object_table with Not_found -> [] in
       let ocs = try Some (assoc_pat cs_pat l)
@@ -245,17 +255,18 @@ let open_canonical_structure i (_,o) =
       in match ocs with
         | None -> object_table := Refmap.add proj ((pat,s)::l) !object_table;
         | Some (c, cs) ->
-            if Flags.is_verbose () then
               let old_can_s = (Termops.print_constr cs.o_DEF)
               and new_can_s = (Termops.print_constr s.o_DEF) in
               let prj = (Nametab.pr_global_env Id.Set.empty proj)
               and hd_val = (pr_cs_pattern cs_pat) in
-              Feedback.msg_warning (strbrk "Ignoring canonical projection to " ++ hd_val
-                             ++ strbrk " by " ++ prj ++ strbrk " in "
-                             ++ new_can_s ++ strbrk ": redundant with " ++ old_can_s)) lo
+              if warn then warn_redundant_canonical_projection (hd_val,prj,new_can_s,old_can_s))
+          lo
+
+let open_canonical_structure i (_, o) =
+  if Int.equal i 1 then add_canonical_structure false o
 
-let cache_canonical_structure o =
-  open_canonical_structure 1 o
+let cache_canonical_structure (_, o) =
+  add_canonical_structure true o
 
 let subst_canonical_structure (subst,(cst,ind as obj)) =
   (* invariant: cst is an evaluable reference. Thus we can take *)
@@ -280,7 +291,7 @@ 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"
+  user_err ~hdr:"object_declare"
     (Nameops.pr_id (basename_of_global ref) ++ str" is not a structure object.")
 
 let check_and_decompose_canonical_structure ref =
@@ -317,7 +328,7 @@ let is_open_canonical_projection env sigma (c,args) =
     (** Check if there is some canonical projection attached to this structure *)
     let _ = Refmap.find ref !object_table in
     try
-      let arg = whd_betadeltaiota env sigma (Stack.nth args n) in
+      let arg = whd_all env sigma (Stack.nth args n) in
       let hd = match kind_of_term arg with App (hd, _) -> hd | _ -> arg in
       not (isConstruct hd)
     with Failure _ -> false
diff --git a/pretyping/redops.ml b/pretyping/redops.ml
index c188995a8..7d65925e5 100644
--- a/pretyping/redops.ml
+++ b/pretyping/redops.ml
@@ -14,25 +14,29 @@ let make_red_flag l =
   let rec add_flag red = function
     | [] -> red
     | FBeta :: lf -> add_flag { red with rBeta = true } lf
-    | FIota :: lf -> add_flag { red with rIota = true } lf
+    | FMatch :: lf -> add_flag { red with rMatch = true } lf
+    | FFix :: lf -> add_flag { red with rFix = true } lf
+    | FCofix :: lf -> add_flag { red with rCofix = true } lf
     | FZeta :: lf -> add_flag { red with rZeta = true } lf
     | FConst l :: lf ->
 	if red.rDelta then
-	  Errors.error
+	  CErrors.error
 	    "Cannot set both constants to unfold and constants not to unfold";
         add_flag { red with rConst = union_consts red.rConst l } lf
     | FDeltaBut l :: lf ->
 	if red.rConst <> [] && not red.rDelta then
-	  Errors.error
+	  CErrors.error
 	    "Cannot set both constants to unfold and constants not to unfold";
         add_flag
           { red with rConst = union_consts red.rConst l; rDelta = true }
           lf
   in
   add_flag
-    {rBeta = false; rIota = false; rZeta = false; rDelta = false; rConst = []}
+    {rBeta = false; rMatch = false; rFix = false; rCofix = false;
+     rZeta = false; rDelta = false; rConst = []}
     l
 
 
 let all_flags =
-  {rBeta = true; rIota = true; rZeta = true; rDelta = true; rConst = []}
+  {rBeta = true; rMatch = true; rFix = true; rCofix = true;
+   rZeta = true; rDelta = true; rConst = []}
diff --git a/pretyping/reductionops.ml b/pretyping/reductionops.ml
index 79cb7a2f6..1fdbbb412 100644
--- a/pretyping/reductionops.ml
+++ b/pretyping/reductionops.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-open Errors
+open CErrors
 open Util
 open Names
 open Term
@@ -26,6 +26,19 @@ exception Elimconst
     their parameters in its stack.
 *)
 
+let refolding_in_reduction = ref false
+let _ = Goptions.declare_bool_option {
+  Goptions.optsync = true; Goptions.optdepr = false;
+  Goptions.optname =
+    "Perform refolding of fixpoints/constants like cbn during reductions";
+  Goptions.optkey = ["Refolding";"Reduction"];
+  Goptions.optread = (fun () -> !refolding_in_reduction);
+  Goptions.optwrite = (fun a -> refolding_in_reduction:=a);
+}
+
+let get_refolding_in_reduction () = !refolding_in_reduction
+let set_refolding_in_reduction = (:=) refolding_in_reduction
+
 (** Machinery to custom the behavior of the reduction *)
 module ReductionBehaviour = struct
   open Globnames
@@ -153,9 +166,6 @@ module Cst_stack = struct
   let empty = []
   let is_empty = CList.is_empty
 
-  let sanity x y =
-    assert(Term.eq_constr x y)
-
   let drop_useless = function
     | _ :: ((_,_,[])::_ as q) -> q
     | l -> l
@@ -164,9 +174,9 @@ module Cst_stack = struct
     let append2cst = function
       | (c,params,[]) -> (c, h::params, [])
       | (c,params,((i,t)::q)) when i = pred (Array.length t) ->
-	 let () = sanity h t.(i) in (c, params, q)
+	(c, params, q)
       | (c,params,(i,t)::q) ->
-	let () = sanity h t.(i) in (c, params, (succ i,t)::q)
+	(c, params, (succ i,t)::q)
     in
       drop_useless (List.map append2cst cst_l)
 
@@ -619,36 +629,21 @@ let rec strong_prodspine redfun sigma c =
 (*** Reduction using bindingss ***)
 (*************************************)
 
-(* Local *)
-let nored = Closure.RedFlags.no_red
-let beta = Closure.beta
-let eta = Closure.RedFlags.mkflags [Closure.RedFlags.fETA]
-let zeta = Closure.RedFlags.mkflags [Closure.RedFlags.fZETA]
-let betaiota = Closure.betaiota
-let betaiotazeta = Closure.betaiotazeta
-
-(* Contextual *)
-let delta = Closure.RedFlags.mkflags [Closure.RedFlags.fDELTA]
-let betalet = Closure.RedFlags.mkflags [Closure.RedFlags.fBETA;Closure.RedFlags.fZETA]
-let betaetalet = Closure.RedFlags.red_add betalet Closure.RedFlags.fETA
-let betadelta = Closure.RedFlags.red_add betalet Closure.RedFlags.fDELTA
-let betadeltaeta = Closure.RedFlags.red_add betadelta Closure.RedFlags.fETA
-let betadeltaiota = Closure.RedFlags.red_add betadelta Closure.RedFlags.fIOTA
-let betadeltaiota_nolet = Closure.betadeltaiotanolet
-let betadeltaiotaeta = Closure.RedFlags.red_add betadeltaiota Closure.RedFlags.fETA
+let eta = CClosure.RedFlags.mkflags [CClosure.RedFlags.fETA]
 
 (* Beta Reduction tools *)
 
-let apply_subst recfun env cst_l t stack =
+let apply_subst recfun env refold cst_l t stack =
   let rec aux env cst_l t stack =
     match (Stack.decomp stack,kind_of_term t) with
     | Some (h,stacktl), Lambda (_,_,c) ->
-      aux (h::env) (Cst_stack.add_param h cst_l) c stacktl
+       let cst_l' = if refold then Cst_stack.add_param h cst_l else cst_l in
+       aux (h::env) cst_l' c stacktl
     | _ -> recfun cst_l (substl env t, stack)
   in aux env cst_l t stack
 
 let stacklam recfun env t stack =
-  apply_subst (fun _ -> recfun) env Cst_stack.empty t stack
+  apply_subst (fun _ -> recfun) env false Cst_stack.empty t stack
 
 let beta_applist (c,l) =
   stacklam Stack.zip [] c (Stack.append_app_list l Stack.empty)
@@ -686,13 +681,17 @@ let magicaly_constant_of_fixbody env reference bd = function
       match constant_opt_value_in env (cst,u) with
       | None -> bd
       | Some t ->
-        let b, csts = Universes.eq_constr_universes t bd in
-    	let subst = Universes.Constraints.fold (fun (l,d,r) acc ->
-    	  Univ.LMap.add (Option.get (Universe.level l)) (Option.get (Universe.level r)) acc)
-    	  csts Univ.LMap.empty
-    	in
-    	let inst = Instance.subst_fn (fun u -> Univ.LMap.find u subst) u in
-          if b then mkConstU (cst,inst) else bd
+        let csts = Universes.eq_constr_universes t bd in
+        begin match csts with
+        | Some csts ->
+          let subst = Universes.Constraints.fold (fun (l,d,r) acc ->
+            Univ.LMap.add (Option.get (Universe.level l)) (Option.get (Universe.level r)) acc)
+            csts Univ.LMap.empty
+          in
+          let inst = Instance.subst_fn (fun u -> Univ.LMap.find u subst) u in
+          mkConstU (cst,inst)
+        | None -> bd
+        end
     with
     | Not_found -> bd
 
@@ -713,11 +712,16 @@ let contract_cofix ?env ?reference (bodynum,(names,types,bodies as typedbodies))
   substl closure bodies.(bodynum)
 
 (** Similar to the "fix" case below *)
-let reduce_and_refold_cofix recfun env cst_l cofix sk =
-  let raw_answer = contract_cofix ~env ?reference:(Cst_stack.reference cst_l) cofix in
+let reduce_and_refold_cofix recfun env refold cst_l cofix sk =
+  let raw_answer =
+    let env = if refold then Some env else None in
+    contract_cofix ?env ?reference:(Cst_stack.reference cst_l) cofix in
   apply_subst
-    (fun x (t,sk') -> recfun x (Cst_stack.best_replace (mkCoFix cofix) cst_l t,sk'))
-    [] Cst_stack.empty raw_answer sk
+    (fun x (t,sk') ->
+      let t' =
+        if refold then Cst_stack.best_replace (mkCoFix cofix) cst_l t else t in
+      recfun x (t',sk'))
+    [] refold Cst_stack.empty raw_answer sk
 
 let reduce_mind_case mia =
   match kind_of_term mia.mconstr with
@@ -753,11 +757,18 @@ let contract_fix ?env ?reference ((recindices,bodynum),(names,types,bodies as ty
     replace the fixpoint by the best constant from [cst_l]
     Other rels are directly substituted by constants "magically found from the
     context" in contract_fix *)
-let reduce_and_refold_fix recfun env cst_l fix sk =
-  let raw_answer = contract_fix ~env ?reference:(Cst_stack.reference cst_l) fix in
+let reduce_and_refold_fix recfun env refold cst_l fix sk =
+  let raw_answer =
+    let env = if refold then None else Some env in
+    contract_fix ?env ?reference:(Cst_stack.reference cst_l) fix in
   apply_subst
-    (fun x (t,sk') -> recfun x (Cst_stack.best_replace (mkFix fix) cst_l t,sk'))
-    [] Cst_stack.empty raw_answer sk
+    (fun x (t,sk') ->
+      let t' =
+        if refold then
+          Cst_stack.best_replace (mkFix fix) cst_l t
+        else t
+      in recfun x (t',sk'))
+    [] refold Cst_stack.empty raw_answer sk
 
 let fix_recarg ((recindices,bodynum),_) stack =
   assert (0 <= bodynum && bodynum < Array.length recindices);
@@ -797,7 +808,7 @@ let equal_stacks (x, l) (y, l') =
     | None -> false
     | Some (lft1,lft2) -> f_equal (x, lft1) (y, lft2) 
 
-let rec whd_state_gen ?csts tactic_mode flags env sigma =
+let rec whd_state_gen ?csts ~refold ~tactic_mode flags env sigma =
   let open Context.Named.Declaration in
   let rec whrec cst_l (x, stack as s) =
     let () = if !debug_RAKAM then
@@ -806,21 +817,22 @@ let rec whd_state_gen ?csts tactic_mode flags env sigma =
              (h 0 (str "<<" ++ Termops.print_constr x ++
 		   str "|" ++ cut () ++ Cst_stack.pr cst_l ++
 		   str "|" ++ cut () ++ Stack.pr Termops.print_constr stack ++
-		   str ">>") ++ fnl ())
+		   str ">>"))
     in
     let fold () =
       let () = if !debug_RAKAM then
-	  let open Pp in Feedback.msg_notice (str "<><><><><>" ++ fnl ()) in
+	  let open Pp in Feedback.msg_notice (str "<><><><><>") in
       (s,cst_l)
     in
     match kind_of_term x with
-    | Rel n when Closure.RedFlags.red_set flags Closure.RedFlags.fDELTA ->
+    | Rel n when CClosure.RedFlags.red_set flags CClosure.RedFlags.fDELTA ->
       (match lookup_rel n env with
       | LocalDef (_,body,_) -> whrec Cst_stack.empty (lift n body, stack)
       | _ -> fold ())
-    | Var id when Closure.RedFlags.red_set flags (Closure.RedFlags.fVAR id) ->
+    | Var id when CClosure.RedFlags.red_set flags (CClosure.RedFlags.fVAR id) ->
       (match lookup_named id env with
-      | LocalDef (_,body,_) -> whrec (Cst_stack.add_cst (mkVar id) cst_l) (body, stack)
+      | LocalDef (_,body,_) ->
+	whrec (if refold then Cst_stack.add_cst (mkVar id) cst_l else cst_l) (body, stack)
       | _ -> fold ())
     | Evar ev ->
       (match safe_evar_value sigma ev with
@@ -830,12 +842,13 @@ let rec whd_state_gen ?csts tactic_mode flags env sigma =
       (match safe_meta_value sigma ev with
       | Some body -> whrec cst_l (body, stack)
       | None -> fold ())
-    | Const (c,u as const) when Closure.RedFlags.red_set flags (Closure.RedFlags.fCONST c) ->
+    | Const (c,u as const) when CClosure.RedFlags.red_set flags (CClosure.RedFlags.fCONST c) ->
        (match constant_opt_value_in env const with
 	| None -> fold ()
 	| Some body ->
 	   if not tactic_mode
-	   then whrec (Cst_stack.add_cst (mkConstU const) cst_l) (body, stack)
+	   then whrec (if refold then Cst_stack.add_cst (mkConstU const) cst_l else cst_l)
+		      (body, stack)
 	   else (* Looks for ReductionBehaviour *)
 	     match ReductionBehaviour.get (Globnames.ConstRef c) with
 	     | None -> whrec (Cst_stack.add_cst (mkConstU const) cst_l) (body, stack)
@@ -870,7 +883,7 @@ let rec whd_state_gen ?csts tactic_mode flags env sigma =
 		      whrec Cst_stack.empty 
 			(arg,Stack.Cst(Stack.Cst_const const,curr,remains,bef,cst_l)::s')
        )
-    | Proj (p, c) when Closure.RedFlags.red_projection flags p ->
+    | Proj (p, c) when CClosure.RedFlags.red_projection flags p ->
       (let pb = lookup_projection p env in
        let kn = Projection.constant p in
        let npars = pb.Declarations.proj_npars 
@@ -911,21 +924,21 @@ let rec whd_state_gen ?csts tactic_mode flags env sigma =
 		       (arg,Stack.Cst(Stack.Cst_proj p,curr,remains,
 				      Stack.append_app [|c|] bef,cst_l)::s'))
 
-    | LetIn (_,b,_,c) when Closure.RedFlags.red_set flags Closure.RedFlags.fZETA ->
-      apply_subst whrec [b] cst_l c stack
+    | LetIn (_,b,_,c) when CClosure.RedFlags.red_set flags CClosure.RedFlags.fZETA ->
+      apply_subst whrec [b] refold cst_l c stack
     | Cast (c,_,_) -> whrec cst_l (c, stack)
     | App (f,cl)  ->
       whrec
-	(Cst_stack.add_args cl cst_l)
+	(if refold then Cst_stack.add_args cl cst_l else cst_l)
 	(f, Stack.append_app cl stack)
     | Lambda (na,t,c) ->
       (match Stack.decomp stack with
-      | Some _ when Closure.RedFlags.red_set flags Closure.RedFlags.fBETA ->
-	apply_subst whrec [] cst_l x stack
-      | None when Closure.RedFlags.red_set flags Closure.RedFlags.fETA ->
+      | Some _ when CClosure.RedFlags.red_set flags CClosure.RedFlags.fBETA ->
+	apply_subst whrec [] refold cst_l x stack
+      | None when CClosure.RedFlags.red_set flags CClosure.RedFlags.fETA ->
 	let env' = push_rel (LocalAssum (na,t)) env in
-	let whrec' = whd_state_gen tactic_mode flags env' sigma in
-        (match kind_of_term (Stack.zip ~refold:true (fst (whrec' (c, Stack.empty)))) with
+	let whrec' = whd_state_gen ~refold ~tactic_mode flags env' sigma in
+        (match kind_of_term (Stack.zip ~refold (fst (whrec' (c, Stack.empty)))) with
         | App (f,cl) ->
 	  let napp = Array.length cl in
 	  if napp > 0 then
@@ -950,16 +963,18 @@ let rec whd_state_gen ?csts tactic_mode flags env sigma =
 	whrec Cst_stack.empty (arg, Stack.Fix(f,bef,cst_l)::s'))
 
     | Construct ((ind,c),u) ->
-      if Closure.RedFlags.red_set flags Closure.RedFlags.fIOTA then
+      let use_match = CClosure.RedFlags.red_set flags CClosure.RedFlags.fMATCH in
+      let use_fix = CClosure.RedFlags.red_set flags CClosure.RedFlags.fFIX in
+      if use_match || use_fix then
 	match Stack.strip_app stack with
-	|args, (Stack.Case(ci, _, lf,_)::s') ->
+	|args, (Stack.Case(ci, _, lf,_)::s') when use_match ->
 	  whrec Cst_stack.empty (lf.(c-1), (Stack.tail ci.ci_npar args) @ s')
-	|args, (Stack.Proj (n,m,p,_)::s') ->
+	|args, (Stack.Proj (n,m,p,_)::s') when use_match ->
 	  whrec Cst_stack.empty (Stack.nth args (n+m), s')
-	|args, (Stack.Fix (f,s',cst_l)::s'') ->
+	|args, (Stack.Fix (f,s',cst_l)::s'') when use_fix ->
 	  let x' = Stack.zip(x,args) in
 	  let out_sk = s' @ (Stack.append_app [|x'|] s'') in
-	  reduce_and_refold_fix whrec env cst_l f out_sk
+	  reduce_and_refold_fix whrec env refold cst_l f out_sk
 	|args, (Stack.Cst (const,curr,remains,s',cst_l) :: s'') ->
 	  let x' = Stack.zip(x,args) in
 	  begin match remains with
@@ -969,7 +984,7 @@ let rec whd_state_gen ?csts tactic_mode flags env sigma =
 	      (match constant_opt_value_in env const with
 	      | None -> fold ()
 	      | Some body ->
-		whrec (Cst_stack.add_cst (mkConstU const) cst_l)
+		whrec (if refold then Cst_stack.add_cst (mkConstU const) cst_l else cst_l)
 		  (body, s' @ (Stack.append_app [|x'|] s'')))
 	    | Stack.Cst_proj p ->
 	      let pb = lookup_projection p env in
@@ -988,14 +1003,14 @@ let rec whd_state_gen ?csts tactic_mode flags env sigma =
 		 Stack.Cst (const,next,remains',s' @ (Stack.append_app [|x'|] bef),cst_l) :: s''')
 	  end
 	|_, (Stack.App _|Stack.Update _|Stack.Shift _)::_ -> assert false
-	|_, [] -> fold ()
+	|_, _ -> fold ()
       else fold ()
 
     | CoFix cofix ->
-      if Closure.RedFlags.red_set flags Closure.RedFlags.fIOTA then
+      if CClosure.RedFlags.red_set flags CClosure.RedFlags.fCOFIX then
 	match Stack.strip_app stack with
 	|args, ((Stack.Case _ |Stack.Proj _)::s') ->
-	  reduce_and_refold_cofix whrec env cst_l cofix stack
+	  reduce_and_refold_cofix whrec env refold cst_l cofix stack
 	|_ -> fold ()
       else fold ()
 
@@ -1010,15 +1025,15 @@ let rec whd_state_gen ?csts tactic_mode flags env sigma =
 let local_whd_state_gen flags sigma =
   let rec whrec (x, stack as s) =
     match kind_of_term x with
-    | LetIn (_,b,_,c) when Closure.RedFlags.red_set flags Closure.RedFlags.fZETA ->
+    | LetIn (_,b,_,c) when CClosure.RedFlags.red_set flags CClosure.RedFlags.fZETA ->
       stacklam whrec [b] c stack
     | Cast (c,_,_) -> whrec (c, stack)
     | App (f,cl)  -> whrec (f, Stack.append_app cl stack)
     | Lambda (_,_,c) ->
       (match Stack.decomp stack with
-      | Some (a,m) when Closure.RedFlags.red_set flags Closure.RedFlags.fBETA ->
+      | Some (a,m) when CClosure.RedFlags.red_set flags CClosure.RedFlags.fBETA ->
 	stacklam whrec [a] c m
-      | None when Closure.RedFlags.red_set flags Closure.RedFlags.fETA ->
+      | None when CClosure.RedFlags.red_set flags CClosure.RedFlags.fETA ->
         (match kind_of_term (Stack.zip (whrec (c, Stack.empty))) with
         | App (f,cl) ->
 	  let napp = Array.length cl in
@@ -1034,7 +1049,7 @@ let local_whd_state_gen flags sigma =
 	| _ -> s)
       | _ -> s)
 
-    | Proj (p,c) when Closure.RedFlags.red_projection flags p ->
+    | Proj (p,c) when CClosure.RedFlags.red_projection flags p ->
       (let pb = lookup_projection p (Global.env ()) in
 	 whrec (c, Stack.Proj (pb.Declarations.proj_npars, pb.Declarations.proj_arg, 
 			       p, Cst_stack.empty)
@@ -1059,21 +1074,23 @@ let local_whd_state_gen flags sigma =
       | None -> s)
 
     | Construct ((ind,c),u) ->
-      if Closure.RedFlags.red_set flags Closure.RedFlags.fIOTA then
+      let use_match = CClosure.RedFlags.red_set flags CClosure.RedFlags.fMATCH in
+      let use_fix = CClosure.RedFlags.red_set flags CClosure.RedFlags.fFIX in
+      if use_match || use_fix then
 	match Stack.strip_app stack with
-	|args, (Stack.Case(ci, _, lf,_)::s') ->
+	|args, (Stack.Case(ci, _, lf,_)::s') when use_match ->
 	  whrec (lf.(c-1), (Stack.tail ci.ci_npar args) @ s')
-	|args, (Stack.Proj (n,m,p,_) :: s') ->
+	|args, (Stack.Proj (n,m,p,_) :: s') when use_match ->
 	  whrec (Stack.nth args (n+m), s')
-	|args, (Stack.Fix (f,s',cst)::s'') ->
+	|args, (Stack.Fix (f,s',cst)::s'') when use_fix ->
 	  let x' = Stack.zip(x,args) in
 	  whrec (contract_fix f, s' @ (Stack.append_app [|x'|] s''))
 	|_, (Stack.App _|Stack.Update _|Stack.Shift _|Stack.Cst _)::_ -> assert false
-	|_, [] -> s
+	|_, _ -> s
       else s
 
     | CoFix cofix ->
-      if Closure.RedFlags.red_set flags Closure.RedFlags.fIOTA then
+      if CClosure.RedFlags.red_set flags CClosure.RedFlags.fCOFIX then
 	match Stack.strip_app stack with
 	|args, ((Stack.Case _ | Stack.Proj _)::s') ->
 	  whrec (contract_cofix cofix, stack)
@@ -1085,7 +1102,7 @@ let local_whd_state_gen flags sigma =
   whrec
 
 let raw_whd_state_gen flags env =
-  let f sigma s = fst (whd_state_gen false flags env sigma s) in
+  let f sigma s = fst (whd_state_gen (get_refolding_in_reduction ()) false flags env sigma s) in
   f
 
 let stack_red_of_state_red f =
@@ -1095,7 +1112,7 @@ let stack_red_of_state_red f =
 (* Drops the Cst_stack *)
 let iterate_whd_gen refold flags env sigma s =
   let rec aux t =
-  let (hd,sk),_ = whd_state_gen refold flags env sigma (t,Stack.empty) in
+  let (hd,sk),_ = whd_state_gen refold false flags env sigma (t,Stack.empty) in
   let whd_sk = Stack.map aux sk in
   Stack.zip ~refold (hd,whd_sk)
   in aux s
@@ -1105,79 +1122,64 @@ let red_of_state_red f sigma x =
 
 (* 0. No Reduction Functions *)
 
-let whd_nored_state = local_whd_state_gen nored
+let whd_nored_state = local_whd_state_gen CClosure.nored
 let whd_nored_stack = stack_red_of_state_red whd_nored_state
 let whd_nored = red_of_state_red whd_nored_state
 
 (* 1. Beta Reduction Functions *)
 
-let whd_beta_state = local_whd_state_gen beta
+let whd_beta_state = local_whd_state_gen CClosure.beta
 let whd_beta_stack = stack_red_of_state_red whd_beta_state
 let whd_beta = red_of_state_red whd_beta_state
 
-(* Nouveau ! *)
-let whd_betaetalet_state = local_whd_state_gen betaetalet
-let whd_betaetalet_stack = stack_red_of_state_red whd_betaetalet_state
-let whd_betaetalet = red_of_state_red whd_betaetalet_state
-
-let whd_betalet_state = local_whd_state_gen betalet
+let whd_betalet_state = local_whd_state_gen CClosure.betazeta
 let whd_betalet_stack = stack_red_of_state_red whd_betalet_state
 let whd_betalet = red_of_state_red whd_betalet_state
 
 (* 2. Delta Reduction Functions *)
 
-let whd_delta_state e = raw_whd_state_gen delta e
+let whd_delta_state e = raw_whd_state_gen CClosure.delta e
 let whd_delta_stack env = stack_red_of_state_red (whd_delta_state env)
 let whd_delta env = red_of_state_red  (whd_delta_state env)
 
-let whd_betadelta_state e = raw_whd_state_gen betadelta e
-let whd_betadelta_stack env =
-  stack_red_of_state_red (whd_betadelta_state env)
-let whd_betadelta env =
-  red_of_state_red (whd_betadelta_state env)
+let whd_betadeltazeta_state e = raw_whd_state_gen CClosure.betadeltazeta e
+let whd_betadeltazeta_stack env =
+  stack_red_of_state_red (whd_betadeltazeta_state env)
+let whd_betadeltazeta env =
+  red_of_state_red (whd_betadeltazeta_state env)
 
 
-let whd_betadeltaeta_state e = raw_whd_state_gen betadeltaeta e
-let whd_betadeltaeta_stack env =
-  stack_red_of_state_red (whd_betadeltaeta_state env)
-let whd_betadeltaeta env =
-  red_of_state_red (whd_betadeltaeta_state env)
-
 (* 3. Iota reduction Functions *)
 
-let whd_betaiota_state = local_whd_state_gen betaiota
+let whd_betaiota_state = local_whd_state_gen CClosure.betaiota
 let whd_betaiota_stack = stack_red_of_state_red whd_betaiota_state
 let whd_betaiota = red_of_state_red whd_betaiota_state
 
-let whd_betaiotazeta_state = local_whd_state_gen betaiotazeta
+let whd_betaiotazeta_state = local_whd_state_gen CClosure.betaiotazeta
 let whd_betaiotazeta_stack = stack_red_of_state_red whd_betaiotazeta_state
 let whd_betaiotazeta = red_of_state_red whd_betaiotazeta_state
 
-let whd_betadeltaiota_state env = raw_whd_state_gen betadeltaiota env
-let whd_betadeltaiota_stack env =
-  stack_red_of_state_red (whd_betadeltaiota_state env)
-let whd_betadeltaiota env =
-  red_of_state_red (whd_betadeltaiota_state env)
-
-let whd_betadeltaiotaeta_state env = raw_whd_state_gen betadeltaiotaeta env
-let whd_betadeltaiotaeta_stack env =
-  stack_red_of_state_red (whd_betadeltaiotaeta_state env)
-let whd_betadeltaiotaeta env =
-  red_of_state_red (whd_betadeltaiotaeta_state env)
+let whd_all_state env = raw_whd_state_gen CClosure.all env
+let whd_all_stack env =
+  stack_red_of_state_red (whd_all_state env)
+let whd_all env =
+  red_of_state_red (whd_all_state env)
 
-let whd_betadeltaiota_nolet_state env = raw_whd_state_gen betadeltaiota_nolet env
-let whd_betadeltaiota_nolet_stack env =
-  stack_red_of_state_red (whd_betadeltaiota_nolet_state env)
-let whd_betadeltaiota_nolet env =
-  red_of_state_red (whd_betadeltaiota_nolet_state env)
+let whd_allnolet_state env = raw_whd_state_gen CClosure.allnolet env
+let whd_allnolet_stack env =
+  stack_red_of_state_red (whd_allnolet_state env)
+let whd_allnolet env =
+  red_of_state_red (whd_allnolet_state env)
 
-(* 4. Eta reduction Functions *)
+(* 4. Ad-hoc eta reduction, does not subsitute evars *)
 
-let whd_eta c = Stack.zip (local_whd_state_gen eta Evd.empty (c,Stack.empty))
+let shrink_eta c = Stack.zip (local_whd_state_gen eta Evd.empty (c,Stack.empty))
 
 (* 5. Zeta Reduction Functions *)
 
-let whd_zeta c = Stack.zip (local_whd_state_gen zeta Evd.empty (c,Stack.empty))
+let whd_zeta_state = local_whd_state_gen CClosure.zeta
+let whd_zeta_stack = stack_red_of_state_red whd_zeta_state
+let whd_zeta = red_of_state_red whd_zeta_state
 
 (****************************************************************************)
 (*                   Reduction Functions                                    *)
@@ -1193,16 +1195,16 @@ let nf_evar = Evarutil.nf_evar
 let clos_norm_flags flgs env sigma t =
   try
     let evars ev = safe_evar_value sigma ev in
-    Closure.norm_val
-      (Closure.create_clos_infos ~evars flgs env)
-      (Closure.inject t)
+    CClosure.norm_val
+      (CClosure.create_clos_infos ~evars flgs env)
+      (CClosure.inject t)
   with e when is_anomaly e -> error "Tried to normalize ill-typed term"
 
-let nf_beta = clos_norm_flags Closure.beta (Global.env ())
-let nf_betaiota = clos_norm_flags Closure.betaiota (Global.env ())
-let nf_betaiotazeta = clos_norm_flags Closure.betaiotazeta (Global.env ())
-let nf_betadeltaiota env sigma =
-  clos_norm_flags Closure.betadeltaiota env sigma
+let nf_beta = clos_norm_flags CClosure.beta (Global.env ())
+let nf_betaiota = clos_norm_flags CClosure.betaiota (Global.env ())
+let nf_betaiotazeta = clos_norm_flags CClosure.betaiotazeta (Global.env ())
+let nf_all env sigma =
+  clos_norm_flags CClosure.all env sigma
 
 
 (********************************************************************)
@@ -1232,8 +1234,8 @@ let pb_equal = function
   | Reduction.CONV -> Reduction.CONV
 
 let report_anomaly _ =
-  let e = UserError ("", Pp.str "Conversion test raised an anomaly") in
-  let e = Errors.push e in
+  let e = UserError (None, Pp.str "Conversion test raised an anomaly") in
+  let e = CErrors.push e in
   iraise e
 
 let test_trans_conversion (f: constr Reduction.extended_conversion_function) reds env sigma x y =
@@ -1264,7 +1266,7 @@ let sigma_compare_sorts env pb s0 s1 sigma =
   match pb with
   | Reduction.CONV -> Evd.set_eq_sort env sigma s0 s1
   | Reduction.CUMUL -> Evd.set_leq_sort env sigma s0 s1
-    
+
 let sigma_compare_instances ~flex i0 i1 sigma =
   try Evd.set_eq_instances ~flex sigma i0 i1
   with Evd.UniversesDiffer
@@ -1397,7 +1399,7 @@ let instance sigma s c =
  * error message. *)
 
 let hnf_prod_app env sigma t n =
-  match kind_of_term (whd_betadeltaiota env sigma t) with
+  match kind_of_term (whd_all env sigma t) with
     | Prod (_,_,b) -> subst1 n b
     | _ -> anomaly ~label:"hnf_prod_app" (Pp.str "Need a product")
 
@@ -1408,7 +1410,7 @@ let hnf_prod_applist env sigma t nl =
   List.fold_left (hnf_prod_app env sigma) t nl
 
 let hnf_lam_app env sigma t n =
-  match kind_of_term (whd_betadeltaiota env sigma t) with
+  match kind_of_term (whd_all env sigma t) with
     | Lambda (_,_,b) -> subst1 n b
     | _ -> anomaly ~label:"hnf_lam_app" (Pp.str "Need an abstraction")
 
@@ -1420,7 +1422,7 @@ let hnf_lam_applist env sigma t nl =
 
 let splay_prod env sigma =
   let rec decrec env m c =
-    let t = whd_betadeltaiota env sigma c in
+    let t = whd_all env sigma c in
     match kind_of_term t with
       | Prod (n,a,c0) ->
 	  decrec (push_rel (LocalAssum (n,a)) env)
@@ -1431,7 +1433,7 @@ let splay_prod env sigma =
 
 let splay_lam env sigma =
   let rec decrec env m c =
-    let t = whd_betadeltaiota env sigma c in
+    let t = whd_all env sigma c in
     match kind_of_term t with
       | Lambda (n,a,c0) ->
 	  decrec (push_rel (LocalAssum (n,a)) env)
@@ -1442,7 +1444,7 @@ let splay_lam env sigma =
 
 let splay_prod_assum env sigma =
   let rec prodec_rec env l c =
-    let t = whd_betadeltaiota_nolet env sigma c in
+    let t = whd_allnolet env sigma c in
     match kind_of_term t with
     | Prod (x,t,c)  ->
 	prodec_rec (push_rel (LocalAssum (x,t)) env)
@@ -1452,7 +1454,7 @@ let splay_prod_assum env sigma =
 	  (Context.Rel.add (LocalDef (x,b,t)) l) c
     | Cast (c,_,_)    -> prodec_rec env l c
     | _               -> 
-      let t' = whd_betadeltaiota env sigma t in
+      let t' = whd_all env sigma t in
 	if Term.eq_constr t t' then l,t
 	else prodec_rec env l t'
   in
@@ -1468,7 +1470,7 @@ let sort_of_arity env sigma c = snd (splay_arity env sigma c)
 
 let splay_prod_n env sigma n =
   let rec decrec env m ln c = if Int.equal m 0 then (ln,c) else
-    match kind_of_term (whd_betadeltaiota env sigma c) with
+    match kind_of_term (whd_all env sigma c) with
       | Prod (n,a,c0) ->
 	  decrec (push_rel (LocalAssum (n,a)) env)
 	    (m-1) (Context.Rel.add (LocalAssum (n,a)) ln) c0
@@ -1478,7 +1480,7 @@ let splay_prod_n env sigma n =
 
 let splay_lam_n env sigma n =
   let rec decrec env m ln c = if Int.equal m 0 then (ln,c) else
-    match kind_of_term (whd_betadeltaiota env sigma c) with
+    match kind_of_term (whd_all env sigma c) with
       | Lambda (n,a,c0) ->
 	  decrec (push_rel (LocalAssum (n,a)) env)
 	    (m-1) (Context.Rel.add (LocalAssum (n,a)) ln) c0
@@ -1487,7 +1489,7 @@ let splay_lam_n env sigma n =
   decrec env n Context.Rel.empty
 
 let is_sort env sigma t =
-  match kind_of_term (whd_betadeltaiota env sigma t) with
+  match kind_of_term (whd_all env sigma t) with
   | Sort s -> true
   | _ -> false
 
@@ -1495,20 +1497,22 @@ let is_sort env sigma t =
    of case/fix (heuristic used by evar_conv) *)
 
 let whd_betaiota_deltazeta_for_iota_state ts env sigma csts s =
+  let refold = get_refolding_in_reduction () in
+  let tactic_mode = false in
   let rec whrec csts s =
-    let (t, stack as s),csts' = whd_state_gen ~csts false betaiota env sigma s in
+    let (t, stack as s),csts' = whd_state_gen ~csts ~refold ~tactic_mode CClosure.betaiota env sigma s in
     match Stack.strip_app stack with
       |args, (Stack.Case _ :: _ as stack') ->
-	let (t_o,stack_o),csts_o = whd_state_gen ~csts:csts' false
-	  (Closure.RedFlags.red_add_transparent betadeltaiota ts) env sigma (t,args) in
+	let (t_o,stack_o),csts_o = whd_state_gen ~csts:csts' ~refold ~tactic_mode
+	  (CClosure.RedFlags.red_add_transparent CClosure.all ts) env sigma (t,args) in
 	if reducible_mind_case t_o then whrec csts_o (t_o, stack_o@stack') else s,csts'
       |args, (Stack.Fix _ :: _ as stack') ->
-	let (t_o,stack_o),csts_o = whd_state_gen ~csts:csts' false
-	  (Closure.RedFlags.red_add_transparent betadeltaiota ts) env sigma (t,args) in
+	let (t_o,stack_o),csts_o = whd_state_gen ~csts:csts' ~refold ~tactic_mode
+	  (CClosure.RedFlags.red_add_transparent CClosure.all ts) env sigma (t,args) in
 	if isConstruct t_o then whrec csts_o (t_o, stack_o@stack') else s,csts'
       |args, (Stack.Proj (n,m,p,_) :: stack'') ->
-	let (t_o,stack_o),csts_o = whd_state_gen ~csts:csts' false
-	  (Closure.RedFlags.red_add_transparent betadeltaiota ts) env sigma (t,args) in
+	let (t_o,stack_o),csts_o = whd_state_gen ~csts:csts' ~refold ~tactic_mode
+	  (CClosure.RedFlags.red_add_transparent CClosure.all ts) env sigma (t,args) in
 	if isConstruct t_o then
 	  whrec Cst_stack.empty (Stack.nth stack_o (n+m), stack'')
 	else s,csts'
@@ -1517,7 +1521,7 @@ let whd_betaiota_deltazeta_for_iota_state ts env sigma csts s =
 
 let find_conclusion env sigma =
   let rec decrec env c =
-    let t = whd_betadeltaiota env sigma c in
+    let t = whd_all env sigma c in
     match kind_of_term t with
       | Prod (x,t,c0) -> decrec (push_rel (LocalAssum (x,t)) env) c0
       | Lambda (x,t,c0) -> decrec (push_rel (LocalAssum (x,t)) env) c0
diff --git a/pretyping/reductionops.mli b/pretyping/reductionops.mli
index b38252e97..4cd7a2a86 100644
--- a/pretyping/reductionops.mli
+++ b/pretyping/reductionops.mli
@@ -28,6 +28,11 @@ module ReductionBehaviour : sig
   val print : Globnames.global_reference -> Pp.std_ppcmds
 end
 
+(** Option telling if reduction should use the refolding machinery of cbn
+   (off by default) *)
+val get_refolding_in_reduction : unit -> bool
+val set_refolding_in_reduction : bool -> unit
+
 (** {6 Machinery about a stack of unfolded constant }
 
     cst applied to params must convertible to term of the state applied to args
@@ -134,21 +139,21 @@ val stack_reduction_of_reduction :
 i*)
 val stacklam : (state -> 'a) -> constr list -> constr -> constr Stack.t -> 'a
 
-val whd_state_gen : ?csts:Cst_stack.t -> bool -> Closure.RedFlags.reds ->
-  Environ.env -> Evd.evar_map -> state -> state * Cst_stack.t
+val whd_state_gen : ?csts:Cst_stack.t -> refold:bool -> tactic_mode:bool ->
+  CClosure.RedFlags.reds -> Environ.env -> Evd.evar_map -> state -> state * Cst_stack.t
 
-val iterate_whd_gen : bool -> Closure.RedFlags.reds ->
+val iterate_whd_gen : bool -> CClosure.RedFlags.reds ->
   Environ.env -> Evd.evar_map -> Term.constr -> Term.constr
 
 (** {6 Generic Optimized Reduction Function using Closures } *)
 
-val clos_norm_flags : Closure.RedFlags.reds -> reduction_function
+val clos_norm_flags : CClosure.RedFlags.reds -> reduction_function
 
 (** Same as [(strong whd_beta[delta][iota])], but much faster on big terms *)
 val nf_beta : local_reduction_function
 val nf_betaiota : local_reduction_function
 val nf_betaiotazeta : local_reduction_function
-val nf_betadeltaiota : reduction_function
+val nf_all : reduction_function
 val nf_evar : evar_map -> constr -> constr
 
 (** Lazy strategy, weak head reduction *)
@@ -158,9 +163,8 @@ val whd_nored : local_reduction_function
 val whd_beta : local_reduction_function
 val whd_betaiota : local_reduction_function
 val whd_betaiotazeta : local_reduction_function
-val whd_betadeltaiota :  contextual_reduction_function
-val whd_betadeltaiota_nolet :  contextual_reduction_function
-val whd_betaetalet : local_reduction_function
+val whd_all :  contextual_reduction_function
+val whd_allnolet :  contextual_reduction_function
 val whd_betalet : local_reduction_function
 
 (** Removes cast and put into applicative form *)
@@ -168,18 +172,16 @@ val whd_nored_stack : local_stack_reduction_function
 val whd_beta_stack : local_stack_reduction_function
 val whd_betaiota_stack : local_stack_reduction_function
 val whd_betaiotazeta_stack : local_stack_reduction_function
-val whd_betadeltaiota_stack : contextual_stack_reduction_function
-val whd_betadeltaiota_nolet_stack : contextual_stack_reduction_function
-val whd_betaetalet_stack : local_stack_reduction_function
+val whd_all_stack : contextual_stack_reduction_function
+val whd_allnolet_stack : contextual_stack_reduction_function
 val whd_betalet_stack : local_stack_reduction_function
 
 val whd_nored_state : local_state_reduction_function
 val whd_beta_state : local_state_reduction_function
 val whd_betaiota_state : local_state_reduction_function
 val whd_betaiotazeta_state : local_state_reduction_function
-val whd_betadeltaiota_state : contextual_state_reduction_function
-val whd_betadeltaiota_nolet_state : contextual_state_reduction_function
-val whd_betaetalet_state : local_state_reduction_function
+val whd_all_state : contextual_state_reduction_function
+val whd_allnolet_state : contextual_state_reduction_function
 val whd_betalet_state : local_state_reduction_function
 
 (** {6 Head normal forms } *)
@@ -187,18 +189,14 @@ val whd_betalet_state : local_state_reduction_function
 val whd_delta_stack :  stack_reduction_function
 val whd_delta_state :  state_reduction_function
 val whd_delta :  reduction_function
-val whd_betadelta_stack :  stack_reduction_function
-val whd_betadelta_state :  state_reduction_function
-val whd_betadelta :  reduction_function
-val whd_betadeltaeta_stack :  stack_reduction_function
-val whd_betadeltaeta_state :  state_reduction_function
-val whd_betadeltaeta :  reduction_function
-val whd_betadeltaiotaeta_stack :  stack_reduction_function
-val whd_betadeltaiotaeta_state :  state_reduction_function
-val whd_betadeltaiotaeta :  reduction_function
-
-val whd_eta : constr -> constr
-val whd_zeta : constr -> constr
+val whd_betadeltazeta_stack :  stack_reduction_function
+val whd_betadeltazeta_state :  state_reduction_function
+val whd_betadeltazeta :  reduction_function
+val whd_zeta_stack : local_stack_reduction_function
+val whd_zeta_state : local_state_reduction_function
+val whd_zeta : local_reduction_function
+
+val shrink_eta : constr -> constr
 
 (** Various reduction functions *)
 
diff --git a/pretyping/retyping.ml b/pretyping/retyping.ml
index 1a6f7832a..5b67af3e7 100644
--- a/pretyping/retyping.ml
+++ b/pretyping/retyping.ml
@@ -7,7 +7,7 @@
 (************************************************************************)
 
 open Pp
-open Errors
+open CErrors
 open Util
 open Term
 open Vars
@@ -20,6 +20,9 @@ open Termops
 open Arguments_renaming
 open Context.Rel.Declaration
 
+module RelDecl = Context.Rel.Declaration
+module NamedDecl = Context.Named.Declaration
+
 type retype_error =
   | NotASort
   | NotAnArity
@@ -62,7 +65,7 @@ let get_type_from_constraints env sigma t =
 let rec subst_type env sigma typ = function
   | [] -> typ
   | h::rest ->
-      match kind_of_term (whd_betadeltaiota env sigma typ) with
+      match kind_of_term (whd_all env sigma typ) with
         | Prod (na,c1,c2) -> subst_type env sigma (subst1 h c2) rest
         | _ -> retype_error NonFunctionalConstruction
 
@@ -71,19 +74,18 @@ let rec subst_type env sigma typ = function
 
 let sort_of_atomic_type env sigma ft args =
   let rec concl_of_arity env n ar args =
-    match kind_of_term (whd_betadeltaiota env sigma ar), args with
+    match kind_of_term (whd_all env sigma ar), args with
     | Prod (na, t, b), h::l -> concl_of_arity (push_rel (LocalDef (na, lift n h, t)) env) (n + 1) b l
     | Sort s, [] -> s
     | _ -> retype_error NotASort
   in concl_of_arity env 0 ft (Array.to_list args)
 
 let type_of_var env id =
-  let open Context.Named.Declaration in
-  try get_type (lookup_named id env)
+  try NamedDecl.get_type (lookup_named id env)
   with Not_found -> retype_error (BadVariable id)
 
 let decomp_sort env sigma t =
-  match kind_of_term (whd_betadeltaiota env sigma t) with
+  match kind_of_term (whd_all env sigma t) with
   | Sort s -> s
   | _ -> retype_error NotASort
 
@@ -94,7 +96,7 @@ let retype ?(polyprop=true) sigma =
       (try strip_outer_cast (Evd.meta_ftype sigma n).Evd.rebus
        with Not_found -> retype_error (BadMeta n))
     | Rel n ->
-	let ty = get_type (lookup_rel n env) in
+	let ty = RelDecl.get_type (lookup_rel n env) in
         lift n ty
     | Var id -> type_of_var env id
     | Const cst -> rename_type_of_constant env cst
@@ -113,7 +115,7 @@ let retype ?(polyprop=true) sigma =
         in
         let n = inductive_nrealdecls_env env (fst (fst (dest_ind_family indf))) in
         let t = betazetaevar_applist sigma n p realargs in
-        (match kind_of_term (whd_betadeltaiota env sigma (type_of env t)) with
+        (match kind_of_term (whd_all env sigma (type_of env t)) with
           | Prod _ -> whd_beta sigma (applist (t, [c]))
           | _ -> t)
     | Lambda (name,c1,c2) ->
@@ -239,7 +241,7 @@ let sorts_of_context env evc ctxt =
   | [] -> env,[]
   | d :: ctxt ->
       let env,sorts = aux ctxt in
-      let s = get_sort_of env evc (get_type d) in
+      let s = get_sort_of env evc (RelDecl.get_type d) in
       (push_rel d env,s::sorts) in
   snd (aux ctxt)
 
diff --git a/pretyping/retyping.mli b/pretyping/retyping.mli
index e4cca2679..8ca40f829 100644
--- a/pretyping/retyping.mli
+++ b/pretyping/retyping.mli
@@ -46,3 +46,5 @@ val type_of_global_reference_knowing_conclusion :
 val sorts_of_context : env -> evar_map -> Context.Rel.t -> sorts list
 
 val expand_projection : env -> evar_map -> Names.projection -> constr -> constr list -> constr
+
+val print_retype_error : retype_error -> Pp.std_ppcmds
diff --git a/pretyping/tacred.ml b/pretyping/tacred.ml
index 7d2504004..7da738508 100644
--- a/pretyping/tacred.ml
+++ b/pretyping/tacred.ml
@@ -7,7 +7,7 @@
 (************************************************************************)
 
 open Pp
-open Errors
+open CErrors
 open Util
 open Names
 open Term
@@ -18,13 +18,16 @@ open Termops
 open Find_subterm
 open Namegen
 open Environ
-open Closure
+open CClosure
 open Reductionops
 open Cbv
 open Patternops
 open Locus
 open Sigma.Notations
 
+module RelDecl = Context.Rel.Declaration
+module NamedDecl = Context.Named.Declaration
+
 (* Errors *)
 
 type reduction_tactic_error =
@@ -38,7 +41,7 @@ exception Elimconst
 exception Redelimination
 
 let error_not_evaluable r =
-  errorlabstrm "error_not_evaluable"
+  user_err ~hdr:"error_not_evaluable"
     (str "Cannot coerce" ++ spc () ++ Nametab.pr_global_env Id.Set.empty r ++
      spc () ++ str "to an evaluable reference.")
 
@@ -54,13 +57,12 @@ let is_evaluable env = function
   | EvalVarRef id -> is_evaluable_var env id
 
 let value_of_evaluable_ref env evref u =
-  let open Context.Named.Declaration in
   match evref with
   | EvalConstRef con -> 
     (try constant_value_in env (con,u)
     with NotEvaluableConst IsProj -> 
       raise (Invalid_argument "value_of_evaluable_ref"))
-  | EvalVarRef id -> lookup_named id env |> get_value |> Option.get
+  | EvalVarRef id -> env |> lookup_named id |> NamedDecl.get_value |> Option.get
 
 let evaluable_of_global_reference env = function
   | ConstRef cst when is_evaluable_const env cst -> EvalConstRef cst
@@ -112,22 +114,18 @@ let unsafe_reference_opt_value env sigma eval =
     | Declarations.Def c -> Some (Mod_subst.force_constr c)
     | _ -> None)
   | EvalVar id ->
-      let open Context.Named.Declaration in
-      lookup_named id env |> get_value
+      env |> lookup_named id |> NamedDecl.get_value
   | EvalRel n ->
-      let open Context.Rel.Declaration in
-      lookup_rel n env |> map_value (lift n) |> get_value
+      env |> lookup_rel n |> RelDecl.map_value (lift n) |> RelDecl.get_value
   | EvalEvar ev -> Evd.existential_opt_value sigma ev
 
 let reference_opt_value env sigma eval u = 
   match eval with
   | EvalConst cst -> constant_opt_value_in env (cst,u)
   | EvalVar id ->
-      let open Context.Named.Declaration in
-      lookup_named id env |> get_value
+      env |> lookup_named id |> NamedDecl.get_value
   | EvalRel n ->
-      let open Context.Rel.Declaration in
-      lookup_rel n env |> map_value (lift n) |> get_value
+      env |> lookup_rel n |> RelDecl.map_value (lift n) |> RelDecl.get_value
   | EvalEvar ev -> Evd.existential_opt_value sigma ev
 
 exception NotEvaluable
@@ -257,7 +255,7 @@ let invert_name labs l na0 env sigma ref = function
 
 let compute_consteval_direct env sigma ref =
   let rec srec env n labs onlyproj c =
-    let c',l = whd_betadelta_stack env sigma c in
+    let c',l = whd_betadeltazeta_stack env sigma c in
     match kind_of_term c' with
       | Lambda (id,t,g) when List.is_empty l && not onlyproj ->
           let open Context.Rel.Declaration in
@@ -541,11 +539,9 @@ let match_eval_ref_value env sigma constr =
   | Const (sp, u) when is_evaluable env (EvalConstRef sp) ->
     Some (constant_value_in env (sp, u))
   | Var id when is_evaluable env (EvalVarRef id) -> 
-     let open Context.Named.Declaration in
-     lookup_named id env |> get_value
+     env |> lookup_named id |> NamedDecl.get_value
   | Rel n ->
-     let open Context.Rel.Declaration in
-     lookup_rel n env |> map_value (lift n) |> get_value
+     env |> lookup_rel n |> RelDecl.map_value (lift n) |> RelDecl.get_value
   | Evar ev -> Evd.existential_opt_value sigma ev
   | _ -> None
 
@@ -870,7 +866,7 @@ let red_product env sigma c =
  *)
 
 let whd_simpl_orelse_delta_but_fix_old env sigma c =
-  let whd_all = whd_betadeltaiota_state env sigma in
+  let whd_all = whd_all_state env sigma in
   let rec redrec (x, stack as s) =
     match kind_of_term x with
       | Lambda (na,t,c) ->
@@ -993,7 +989,7 @@ let e_contextually byhead (occs,c) f = { e_redfun = begin fun env sigma t ->
       incr pos;
       if ok then begin
         if Option.has_some nested then
-          errorlabstrm "" (str "The subterm at occurrence " ++ int (Option.get nested) ++ str " overlaps with the subterm at occurrence " ++ int (!pos-1) ++ str ".");
+          user_err  (str "The subterm at occurrence " ++ int (Option.get nested) ++ str " overlaps with the subterm at occurrence " ++ int (!pos-1) ++ str ".");
         (* Skip inner occurrences for stable counting of occurrences *)
         if locs != [] then
           ignore (traverse_below (Some (!pos-1)) envc t);
@@ -1125,7 +1121,7 @@ let cbv_norm_flags flags env sigma t =
 
 let cbv_beta = cbv_norm_flags beta empty_env
 let cbv_betaiota = cbv_norm_flags betaiota empty_env
-let cbv_betadeltaiota env sigma =  cbv_norm_flags betadeltaiota env sigma
+let cbv_betadeltaiota env sigma =  cbv_norm_flags all env sigma
 
 let compute = cbv_betadeltaiota
 
@@ -1159,13 +1155,13 @@ let pattern_occs loccs_trm = { e_redfun = begin fun env sigma c ->
 let check_privacy env ind =
   let spec = Inductive.lookup_mind_specif env (fst ind) in
   if Inductive.is_private spec then
-    errorlabstrm "" (str "case analysis on a private type.")
+    user_err  (str "case analysis on a private type.")
   else ind
 
 let check_not_primitive_record env ind =
   let spec = Inductive.lookup_mind_specif env (fst ind) in
     if Inductive.is_primitive_record spec then
-      errorlabstrm "" (str "case analysis on a primitive record type: " ++
+      user_err  (str "case analysis on a primitive record type: " ++
 		       str "use projections or let instead.")
     else ind
 
@@ -1182,14 +1178,14 @@ let reduce_to_ind_gen allow_product env sigma t =
 	  if allow_product then
 	    elimrec (push_rel (LocalAssum (n,ty)) env) t' ((LocalAssum (n,ty))::l)
 	  else
-	    errorlabstrm "" (str"Not an inductive definition.")
+	    user_err  (str"Not an inductive definition.")
       | _ ->
 	  (* Last chance: we allow to bypass the Opaque flag (as it
 	     was partially the case between V5.10 and V8.1 *)
-	  let t' = whd_betadeltaiota env sigma t in
+	  let t' = whd_all env sigma t in
 	  match kind_of_term (fst (decompose_app t')) with
 	    | Ind ind-> (check_privacy env ind, it_mkProd_or_LetIn t' l)
-	    | _ -> errorlabstrm "" (str"Not an inductive product.")
+	    | _ -> user_err  (str"Not an inductive product.")
   in
   elimrec env t []
 
@@ -1239,7 +1235,7 @@ let one_step_reduce env sigma c =
   applist (redrec (c,[]))
 
 let error_cannot_recognize ref =
-  errorlabstrm ""
+  user_err 
     (str "Cannot recognize a statement based on " ++
      Nametab.pr_global_env Id.Set.empty ref ++ str".")
 
diff --git a/pretyping/tacred.mli b/pretyping/tacred.mli
index 195b21bbf..f8dfe1adf 100644
--- a/pretyping/tacred.mli
+++ b/pretyping/tacred.mli
@@ -66,7 +66,7 @@ val pattern_occs : (occurrences * constr) list -> e_reduction_function
 (** Rem: Lazy strategies are defined in Reduction *)
 
 (** Call by value strategy (uses Closures) *)
-val cbv_norm_flags : Closure.RedFlags.reds ->  reduction_function
+val cbv_norm_flags : CClosure.RedFlags.reds ->  reduction_function
   val cbv_beta : local_reduction_function
   val cbv_betaiota : local_reduction_function
   val cbv_betadeltaiota :  reduction_function
diff --git a/pretyping/typeclasses.ml b/pretyping/typeclasses.ml
index 3ff96cd72..01f3620f1 100644
--- a/pretyping/typeclasses.ml
+++ b/pretyping/typeclasses.ml
@@ -17,6 +17,9 @@ open Util
 open Typeclasses_errors
 open Libobject
 open Context.Rel.Declaration
+
+module RelDecl = Context.Rel.Declaration
+module NamedDecl = Context.Named.Declaration
 (*i*)
 
 let typeclasses_unique_solutions = ref false
@@ -46,10 +49,10 @@ let set_typeclass_transparency gr local c = Hook.get set_typeclass_transparency
 let (classes_transparent_state, classes_transparent_state_hook) = Hook.make ()
 let classes_transparent_state () = Hook.get classes_transparent_state ()
 
-let solve_instantiation_problem = ref (fun _ _ _ _ -> assert false)
+let get_solve_one_instance, solve_one_instance_hook = Hook.make ()
 
 let resolve_one_typeclass ?(unique=get_typeclasses_unique_solutions ()) env evm t =
-  !solve_instantiation_problem env evm t unique
+  Hook.get get_solve_one_instance env evm t unique
 
 type direction = Forward | Backward
 
@@ -65,7 +68,8 @@ type typeclass = {
   cl_props : Context.Rel.t;
 
   (* The method implementaions as projections. *)
-  cl_projs : (Name.t * (direction * int option) option * constant option) list;
+  cl_projs : (Name.t * (direction * Vernacexpr.hint_info_expr) option
+	      * constant option) list;
   
   cl_strict : bool;
 
@@ -76,10 +80,9 @@ type typeclasses = typeclass Refmap.t
 
 type instance = {
   is_class: global_reference;
-  is_pri: int option;
+  is_info: Vernacexpr.hint_info_expr;
   (* Sections where the instance should be redeclared,
-     -1 for discard, 0 for none, mutable to avoid redeclarations
-     when multiple rebuild_object happen. *)
+     -1 for discard, 0 for none. *)
   is_global: int;
   is_poly: bool;
   is_impl: global_reference;
@@ -89,15 +92,15 @@ type instances = (instance Refmap.t) Refmap.t
 
 let instance_impl is = is.is_impl
 
-let instance_priority is = is.is_pri
+let hint_priority is = is.is_info.Vernacexpr.hint_priority
 
-let new_instance cl pri glob poly impl =
+let new_instance cl info glob poly impl =
   let global =
     if glob then Lib.sections_depth ()
     else -1
   in
     { is_class = cl.cl_impl;
-      is_pri = pri ;
+      is_info = info ;
       is_global = global ;
       is_poly = poly;
       is_impl = impl }
@@ -150,7 +153,7 @@ let dest_class_arity env c =
 
 let class_of_constr c =
   try Some (dest_class_arity (Global.env ()) c)
-  with e when Errors.noncritical e -> None
+  with e when CErrors.noncritical e -> None
 
 let is_class_constr c = 
   try let gr, u = Universes.global_of_constr c in
@@ -181,7 +184,7 @@ let subst_class (subst,cl) =
   let do_subst_con c = Mod_subst.subst_constant subst c
   and do_subst c = Mod_subst.subst_mps subst c
   and do_subst_gr gr = fst (subst_global subst gr) in
-  let do_subst_ctx = List.smartmap (map_constr do_subst) in
+  let do_subst_ctx = List.smartmap (RelDecl.map_constr do_subst) in
   let do_subst_context (grs,ctx) =
     List.smartmap (Option.smartmap (fun (gr,b) -> do_subst_gr gr, b)) grs,
     do_subst_ctx ctx in
@@ -197,19 +200,16 @@ let subst_class (subst,cl) =
 let discharge_class (_,cl) =
   let repl = Lib.replacement_context () in
   let rel_of_variable_context ctx = List.fold_right
-    ( fun (n,_,b,t) (ctx', subst) ->
-        let decl = match b with
-                   | None -> LocalAssum (Name n, substn_vars 1 subst t)
-		   | Some b -> LocalDef (Name n, substn_vars 1 subst b, substn_vars 1 subst t)
-	in
-	(decl :: ctx', n :: subst)
+    ( fun (decl,_) (ctx', subst) ->
+        let decl' = decl |> NamedDecl.map_constr (substn_vars 1 subst) |> NamedDecl.to_rel_decl in
+	(decl' :: ctx', NamedDecl.get_id decl :: subst)
     ) ctx ([], []) in
   let discharge_rel_context subst n rel =
     let rel = Context.Rel.map (Cooking.expmod_constr repl) rel in
     let ctx, _ =
       List.fold_right
 	(fun decl (ctx, k) ->
-	   map_constr (substn_vars k subst) decl :: ctx, succ k
+	   RelDecl.map_constr (substn_vars k subst) decl :: ctx, succ k
 	)
 	rel ([], n)
     in ctx
@@ -222,7 +222,7 @@ let discharge_class (_,cl) =
   let discharge_context ctx' subst (grs, ctx) =
     let grs' =
       let newgrs = List.map (fun decl ->
-			     match decl |> get_type |> class_of_constr with
+			     match decl |> RelDecl.get_type |> class_of_constr with
 			     | None -> None
 			     | Some (_, ((tc,_), _)) -> Some (tc.cl_impl, true))
 			    ctx'
@@ -249,7 +249,7 @@ let rebuild_class cl =
   try 
     let cst = Tacred.evaluable_of_global_reference (Global.env ()) cl.cl_impl in
       set_typeclass_transparency cst false false; cl
-  with e when Errors.noncritical e -> cl
+  with e when CErrors.noncritical e -> cl
 
 let class_input : typeclass -> obj =
   declare_object
@@ -272,9 +272,11 @@ let check_instance env sigma c =
     let (evd, c) = resolve_one_typeclass env sigma
       (Retyping.get_type_of env sigma c) in
       not (Evd.has_undefined evd)
-  with e when Errors.noncritical e -> false
+  with e when CErrors.noncritical e -> false
+
+open Vernacexpr
 
-let build_subclasses ~check env sigma glob pri =
+let build_subclasses ~check env sigma glob { hint_priority = pri } =
   let _id = Nametab.basename_of_global glob in
   let _next_id = 
     let i = ref (-1) in 
@@ -297,24 +299,24 @@ let build_subclasses ~check env sigma glob pri =
 	   match b with 
 	   | None -> None
 	   | Some (Backward, _) -> None
-	   | Some (Forward, pri') ->
+	   | Some (Forward, info) ->
 	     let proj = Option.get proj in
 	     let body = it_mkLambda_or_LetIn (mkApp (mkConstU (proj,u), projargs)) rels in
 	       if check && check_instance env sigma body then None
 	       else 
-		 let pri = 
-		   match pri, pri' with
+		 let newpri =
+		   match pri, info.hint_priority with
 		   | Some p, Some p' -> Some (p + p')
 		   | Some p, None -> Some (p + 1)
 		   | _, _ -> None
 		 in
-		   Some (ConstRef proj, pri, body)) tc.cl_projs 
+		   Some (ConstRef proj, { info with hint_priority = newpri }, body)) tc.cl_projs
 	in
-	let declare_proj hints (cref, pri, body) =
+	let declare_proj hints (cref, info, body) =
 	  let path' = cref :: path in
 	  let ty = Retyping.get_type_of env sigma body in
 	  let rest = aux pri body ty path' in
-	    hints @ (path', pri, body) :: rest
+	    hints @ (path', info, body) :: rest
 	in List.fold_left declare_proj [] projs 
   in
   let term = Universes.constr_of_global_univ (glob,Univ.UContext.instance ctx) in
@@ -368,11 +370,11 @@ let is_local i = Int.equal i.is_global (-1)
 let add_instance check inst =
   let poly = Global.is_polymorphic inst.is_impl in
   add_instance_hint (IsGlobal inst.is_impl) [inst.is_impl] (is_local inst) 
-    inst.is_pri poly;
+    inst.is_info poly;
   List.iter (fun (path, pri, c) -> add_instance_hint (IsConstr c) path
     (is_local inst) pri poly)
     (build_subclasses ~check:(check && not (isVarRef inst.is_impl))
-       (Global.env ()) (Evd.from_env (Global.env ())) inst.is_impl inst.is_pri)
+       (Global.env ()) (Evd.from_env (Global.env ())) inst.is_impl inst.is_info)
 
 let rebuild_instance (action, inst) =
   let () = match action with
@@ -404,26 +406,22 @@ let remove_instance i =
   Lib.add_anonymous_leaf (instance_input (RemoveInstance, i));
   remove_instance_hint i.is_impl
 
-let declare_instance pri local glob =
+let declare_instance info local glob =
   let ty = Global.type_of_global_unsafe glob in
+  let info = Option.default {hint_priority = None; hint_pattern = None} info in
     match class_of_constr ty with
     | Some (rels, ((tc,_), args) as _cl) ->
-      add_instance (new_instance tc pri (not local) (Flags.use_polymorphic_flag ()) glob)
-(*       let path, hints = build_subclasses (not local) (Global.env ()) Evd.empty glob in *)
-(*       let entries = List.map (fun (path, pri, c) -> (pri, local, path, c)) hints in *)
-(* 	Auto.add_hints local [typeclasses_db] (Auto.HintsResolveEntry entries); *)
-(* 	Auto.add_hints local [typeclasses_db]  *)
-(* 	(Auto.HintsCutEntry (PathSeq (PathStar (PathAtom PathAny), path))) *)
+      add_instance (new_instance tc info (not local) (Flags.use_polymorphic_flag ()) glob)
     | None -> ()
 
 let add_class cl =
   add_class cl;
   List.iter (fun (n, inst, body) ->
 	     match inst with
-	     | Some (Backward, pri) ->
+	     | Some (Backward, info) ->
 	       (match body with
-	       | None -> Errors.error "Non-definable projection can not be declared as a subinstance"
-	       | Some b -> declare_instance pri false (ConstRef b))
+	       | None -> CErrors.error "Non-definable projection can not be declared as a subinstance"
+	       | Some b -> declare_instance (Some info) false (ConstRef b))
 	     | _ -> ())
   cl.cl_projs
 
@@ -501,7 +499,7 @@ let is_resolvable evi =
   Option.is_empty (Store.get evi.evar_extra resolvable)
 
 let mark_resolvability_undef b evi =
-  if is_resolvable evi = b then evi
+  if is_resolvable evi == (b : bool) then evi
   else
     let t = set_resolvable evi.evar_extra b in
     { evi with evar_extra = t }
@@ -539,16 +537,16 @@ let has_typeclasses filter evd =
   in
   Evar.Map.exists check (Evd.undefined_map evd)
 
-let solve_instantiations_problem = ref (fun _ _ _ _ _ _ -> assert false)
+let get_solve_all_instances, solve_all_instances_hook = Hook.make ()
 
-let solve_problem env evd filter unique split fail =
-  !solve_instantiations_problem env evd filter unique split fail
+let solve_all_instances env evd filter unique split fail =
+  Hook.get get_solve_all_instances env evd filter unique split fail
 
 (** Profiling resolution of typeclasses *)
 (* let solve_classeskey = Profile.declare_profile "solve_typeclasses" *)
 (* let solve_problem = Profile.profile5 solve_classeskey solve_problem *)
 
-let resolve_typeclasses ?(filter=no_goals) ?(unique=get_typeclasses_unique_solutions ())
+let resolve_typeclasses ?(fast_path = true) ?(filter=no_goals) ?(unique=get_typeclasses_unique_solutions ())
     ?(split=true) ?(fail=true) env evd =
-  if not (has_typeclasses filter evd) then evd
-  else solve_problem env evd filter unique split fail
+  if fast_path && not (has_typeclasses filter evd) then evd
+  else solve_all_instances env evd filter unique split fail
diff --git a/pretyping/typeclasses.mli b/pretyping/typeclasses.mli
index 7bb0ef3ab..620bc367b 100644
--- a/pretyping/typeclasses.mli
+++ b/pretyping/typeclasses.mli
@@ -32,7 +32,7 @@ type typeclass = {
       Some may be undefinable due to sorting restrictions or simply undefined if 
       no name is provided. The [int option option] indicates subclasses whose hint has
       the given priority. *)
-  cl_projs : (Name.t * (direction * int option) option * constant option) list;
+  cl_projs : (Name.t * (direction * Vernacexpr.hint_info_expr) option * constant option) list;
 
   (** Whether we use matching or full unification during resolution *)
   cl_strict : bool; 
@@ -50,7 +50,7 @@ val all_instances : unit -> instance list
 
 val add_class : typeclass -> unit
 
-val new_instance : typeclass -> int option -> bool -> Decl_kinds.polymorphic -> 
+val new_instance : typeclass -> Vernacexpr.hint_info_expr -> bool -> Decl_kinds.polymorphic ->
   global_reference -> instance
 val add_instance : instance -> unit
 val remove_instance : instance -> unit
@@ -71,7 +71,7 @@ val class_of_constr : constr -> (Context.Rel.t * (typeclass puniverses * constr
   
 val instance_impl : instance -> global_reference
 
-val instance_priority : instance -> int option
+val hint_priority : instance -> int option
 
 val is_class : global_reference -> bool
 val is_instance : global_reference -> bool
@@ -101,7 +101,7 @@ val mark_resolvable : evar_info -> evar_info
 val is_class_evar : evar_map -> evar_info -> bool
 val is_class_type : evar_map -> types -> bool
 
-val resolve_typeclasses : ?filter:evar_filter -> ?unique:bool -> 
+val resolve_typeclasses : ?fast_path:bool -> ?filter:evar_filter -> ?unique:bool ->
   ?split:bool -> ?fail:bool -> env -> evar_map -> evar_map
 val resolve_one_typeclass : ?unique:bool -> env -> evar_map -> types -> open_constr
 
@@ -113,21 +113,22 @@ val classes_transparent_state : unit -> transparent_state
 
 val add_instance_hint_hook : 
   (global_reference_or_constr -> global_reference list ->
-   bool (* local? *) -> int option -> Decl_kinds.polymorphic -> unit) Hook.t
+   bool (* local? *) -> Vernacexpr.hint_info_expr -> Decl_kinds.polymorphic -> unit) Hook.t
 val remove_instance_hint_hook : (global_reference -> unit) Hook.t
 val add_instance_hint : global_reference_or_constr -> global_reference list -> 
-  bool -> int option -> Decl_kinds.polymorphic -> unit
+  bool -> Vernacexpr.hint_info_expr -> Decl_kinds.polymorphic -> unit
 val remove_instance_hint : global_reference -> unit
 
-val solve_instantiations_problem : (env -> evar_map -> evar_filter -> bool -> bool -> bool -> evar_map) ref
-val solve_instantiation_problem : (env -> evar_map -> types -> bool -> open_constr) ref
+val solve_all_instances_hook : (env -> evar_map -> evar_filter -> bool -> bool -> bool -> evar_map) Hook.t
+val solve_one_instance_hook : (env -> evar_map -> types -> bool -> open_constr) Hook.t
 
-val declare_instance : int option -> bool -> global_reference -> unit
+val declare_instance : Vernacexpr.hint_info_expr option -> bool -> global_reference -> unit
 
 
 (** Build the subinstances hints for a given typeclass object.
     check tells if we should check for existence of the 
     subinstances and add only the missing ones. *)
 
-val build_subclasses : check:bool -> env -> evar_map -> global_reference -> int option (* priority *) ->
-  (global_reference list * int option * constr) list
+val build_subclasses : check:bool -> env -> evar_map -> global_reference ->
+		       Vernacexpr.hint_info_expr ->
+		       (global_reference list * Vernacexpr.hint_info_expr * constr) list
diff --git a/pretyping/typing.ml b/pretyping/typing.ml
index 52afa7f83..e79e3d46f 100644
--- a/pretyping/typing.ml
+++ b/pretyping/typing.ml
@@ -7,7 +7,7 @@
 (************************************************************************)
 
 open Pp
-open Errors
+open CErrors
 open Util
 open Term
 open Vars
@@ -36,7 +36,7 @@ let inductive_type_knowing_parameters env (ind,u) jl =
   Inductive.type_of_inductive_knowing_parameters env (mspec,u) paramstyp
 
 let e_type_judgment env evdref j =
-  match kind_of_term (whd_betadeltaiota env !evdref j.uj_type) with
+  match kind_of_term (whd_all env !evdref j.uj_type) with
     | Sort s -> {utj_val = j.uj_val; utj_type = s }
     | Evar ev ->
         let (evd,s) = Evardefine.define_evar_as_sort env !evdref ev in
@@ -54,7 +54,7 @@ let e_judge_of_apply env evdref funj argjv =
       { uj_val  = mkApp (j_val funj, Array.map j_val argjv);
         uj_type = typ }
   | hj::restjl ->
-      match kind_of_term (whd_betadeltaiota env !evdref typ) with
+      match kind_of_term (whd_all env !evdref typ) with
       | Prod (_,c1,c2) ->
 	 if Evarconv.e_cumul env evdref hj.uj_type c1 then
 	   apply_rec (n+1) (subst1 hj.uj_val c2) restjl
@@ -87,7 +87,7 @@ let e_is_correct_arity env evdref c pj ind specif params =
   let allowed_sorts = elim_sorts specif in
   let error () = error_elim_arity env ind allowed_sorts c pj None in
   let rec srec env pt ar =
-    let pt' = whd_betadeltaiota env !evdref pt in
+    let pt' = whd_all env !evdref pt in
     match kind_of_term pt', ar with
     | Prod (na1,a1,t), (LocalAssum (_,a1'))::ar' ->
         if not (Evarconv.e_cumul env evdref a1 a1') then error ();
@@ -110,22 +110,32 @@ let e_type_case_branches env evdref (ind,largs) pj c =
   let nparams = inductive_params specif in
   let (params,realargs) = List.chop nparams largs in
   let p = pj.uj_val in
-  let univ = e_is_correct_arity env evdref c pj ind specif params in
+  let () = e_is_correct_arity env evdref c pj ind specif params in
   let lc = build_branches_type ind specif params p in
   let n = (snd specif).Declarations.mind_nrealdecls in
   let ty = whd_betaiota !evdref (lambda_applist_assum (n+1) p (realargs@[c])) in
-  (lc, ty, univ)
+  (lc, ty)
 
 let e_judge_of_case env evdref ci pj cj lfj =
   let indspec =
     try find_mrectype env !evdref cj.uj_type
     with Not_found -> error_case_not_inductive env cj in
   let _ = check_case_info env (fst indspec) ci in
-  let (bty,rslty,univ) = e_type_case_branches env evdref indspec pj cj.uj_val in
+  let (bty,rslty) = e_type_case_branches env evdref indspec pj cj.uj_val in
   e_check_branch_types env evdref (fst indspec) cj (lfj,bty);
   { uj_val  = mkCase (ci, pj.uj_val, cj.uj_val, Array.map j_val lfj);
     uj_type = rslty }
 
+let check_type_fixpoint loc env evdref lna lar vdefj =
+  let lt = Array.length vdefj in
+    if Int.equal (Array.length lar) lt then
+      for i = 0 to lt-1 do
+        if not (Evarconv.e_cumul env evdref (vdefj.(i)).uj_type
+		  (lift lt lar.(i))) then
+          Pretype_errors.error_ill_typed_rec_body ~loc env !evdref
+            i lna vdefj lar
+      done
+
 (* FIXME: might depend on the level of actual parameters!*)
 let check_allowed_sort env sigma ind c p =
   let pj = Retyping.get_judgment_of env sigma p in
@@ -263,7 +273,7 @@ and execute_recdef env evdref (names,lar,vdef) =
   let env1 = push_rec_types (names,lara,vdef) env in
   let vdefj = execute_array env1 evdref vdef in
   let vdefv = Array.map j_val vdefj in
-  let _ = type_fixpoint env1 names lara vdefj in
+  let _ = check_type_fixpoint Loc.ghost env1 evdref names lara vdefj in
   (names,lara,vdefv)
 
 and execute_array env evdref = Array.map (execute env evdref)
diff --git a/pretyping/typing.mli b/pretyping/typing.mli
index e524edcca..04e5e40bc 100644
--- a/pretyping/typing.mli
+++ b/pretyping/typing.mli
@@ -39,3 +39,8 @@ val e_solve_evars : env -> evar_map ref -> constr -> constr
 (** (first constr is term to match, second is return predicate) *)
 val check_allowed_sort : env -> evar_map -> pinductive -> constr -> constr ->
   unit
+
+(** Raise an error message if bodies have types not unifiable with the
+    expected ones *)
+val check_type_fixpoint : Loc.t -> env -> evar_map ref ->
+  Names.Name.t array -> types array -> unsafe_judgment array -> unit
diff --git a/pretyping/unification.ml b/pretyping/unification.ml
index cdd543d25..a91c30df6 100644
--- a/pretyping/unification.ml
+++ b/pretyping/unification.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-open Errors
+open CErrors
 open Pp
 open Util
 open Names
@@ -29,7 +29,9 @@ open Locus
 open Locusops
 open Find_subterm
 open Sigma.Notations
-open Context.Named.Declaration
+
+module RelDecl = Context.Rel.Declaration
+module NamedDecl = Context.Named.Declaration
 
 let keyed_unification = ref (false)
 let _ = Goptions.declare_bool_option {
@@ -78,9 +80,8 @@ let occur_meta_evd sigma mv c =
 let abstract_scheme env evd c l lname_typ =
   List.fold_left2
     (fun (t,evd) (locc,a) decl ->
-       let open Context.Rel.Declaration in
-       let na = get_name decl in
-       let ta = get_type decl in
+       let na = RelDecl.get_name decl in
+       let ta = RelDecl.get_type decl in
        let na = match kind_of_term a with Var id -> Name id | _ -> na in
 (* [occur_meta ta] test removed for support of eelim/ecase but consequences
    are unclear...
@@ -460,7 +461,7 @@ let use_metas_pattern_unification flags nb l =
      Array.for_all (fun c -> isRel c && destRel c <= nb) l
 
 type key = 
-  | IsKey of Closure.table_key
+  | IsKey of CClosure.table_key
   | IsProj of projection * constr
 
 let expand_table_key env = function
@@ -479,8 +480,8 @@ let unfold_projection env p stk =
 let expand_key ts env sigma = function
   | Some (IsKey k) -> expand_table_key env k
   | Some (IsProj (p, c)) -> 
-    let red = Stack.zip (fst (whd_betaiota_deltazeta_for_iota_state ts env sigma 
-				Cst_stack.empty (c, unfold_projection env p [])))
+    let red = Stack.zip (fst (whd_betaiota_deltazeta_for_iota_state ts env sigma
+                               Cst_stack.empty (c, unfold_projection env p [])))
     in if Term.eq_constr (mkProj (p, c)) red then None else Some red
   | None -> None
 
@@ -557,22 +558,26 @@ let force_eqs c =
     c Universes.Constraints.empty
 
 let constr_cmp pb sigma flags t u =
-  let b, cstrs = 
+  let cstrs =
     if pb == Reduction.CONV then Universes.eq_constr_universes t u
     else Universes.leq_constr_universes t u
   in 
-    if b then 
-      try Evd.add_universe_constraints sigma cstrs, b
+  match cstrs with
+  | Some cstrs ->
+      begin try Evd.add_universe_constraints sigma cstrs, true
       with Univ.UniverseInconsistency _ -> sigma, false
       | Evd.UniversesDiffer -> 
 	if is_rigid_head flags t then 
-	  try Evd.add_universe_constraints sigma (force_eqs cstrs), b
+	  try Evd.add_universe_constraints sigma (force_eqs cstrs), true
 	  with Univ.UniverseInconsistency _ -> sigma, false
 	else sigma, false
-    else sigma, b
+      end
+  | None ->
+    sigma, false
     
 let do_reduce ts (env, nb) sigma c =
-  Stack.zip (fst (whd_betaiota_deltazeta_for_iota_state ts env sigma Cst_stack.empty (c, Stack.empty)))
+  Stack.zip (fst (whd_betaiota_deltazeta_for_iota_state
+		  ts env sigma Cst_stack.empty (c, Stack.empty)))
 
 let use_full_betaiota flags =
   flags.modulo_betaiota && Flags.version_strictly_greater Flags.V8_3
@@ -742,7 +747,7 @@ let rec unify_0_with_initial_metas (sigma,ms,es as subst) conv_at_top env cv_pb
 		 then Evd.set_leq_sort curenv sigma s1 s2 
 		 else Evd.set_eq_sort curenv sigma s1 s2
 	       in (sigma', metasubst, evarsubst)
-	     with e when Errors.noncritical e ->
+	     with e when CErrors.noncritical e ->
                error_cannot_unify curenv sigma (m,n))
 
 	| Lambda (na,t1,c1), Lambda (_,t2,c2) ->
@@ -1058,8 +1063,10 @@ let rec unify_0_with_initial_metas (sigma,ms,es as subst) conv_at_top env cv_pb
   let opt = { at_top = conv_at_top; with_types = false; with_cs = true } in
   try
   let res = 
-    if occur_meta_or_undefined_evar sigma m || occur_meta_or_undefined_evar sigma n
-      || subterm_restriction opt flags then None
+    if subterm_restriction opt flags ||
+      occur_meta_or_undefined_evar sigma m || occur_meta_or_undefined_evar sigma n
+    then
+      None
     else 
       let sigma, b = match flags.modulo_conv_on_closed_terms with
 	| Some convflags -> infer_conv ~pb:cv_pb ~ts:convflags env sigma m n
@@ -1078,8 +1085,9 @@ let rec unify_0_with_initial_metas (sigma,ms,es as subst) conv_at_top env cv_pb
     if !debug_unification then Feedback.msg_debug (str "Leaving unification with success");
     a
   with e ->
+    let e = CErrors.push e in
     if !debug_unification then Feedback.msg_debug (str "Leaving unification with failure");
-    raise e
+    iraise e
 
 
 let unify_0 env sigma = unify_0_with_initial_metas (sigma,[],[]) true env
@@ -1088,7 +1096,7 @@ let left = true
 let right = false
 
 let rec unify_with_eta keptside flags env sigma c1 c2 =
-(* Question: try whd_betadeltaiota on ci if not two lambdas? *)
+(* Question: try whd_all on ci if not two lambdas? *)
   match kind_of_term c1, kind_of_term c2 with
   | (Lambda (na,t1,c1'), Lambda (_,t2,c2')) ->
     let env' = push_rel_assum (na,t1) env in
@@ -1136,11 +1144,11 @@ let merge_instances env sigma flags st1 st2 c1 c2 =
       else (right, st2, res)
   | (IsSuperType,IsSubType) ->
     (try (left, IsSubType, unify_0 env sigma CUMUL flags c2 c1)
-     with e when Errors.noncritical e ->
+     with e when CErrors.noncritical e ->
        (right, IsSubType, unify_0 env sigma CUMUL flags c1 c2))
   | (IsSubType,IsSuperType) ->
     (try (left, IsSuperType, unify_0 env sigma CUMUL flags c1 c2)
-     with e when Errors.noncritical e ->
+     with e when CErrors.noncritical e ->
        (right, IsSuperType, unify_0 env sigma CUMUL flags c2 c1))
     
 (* Unification
@@ -1198,7 +1206,7 @@ let applyHead env (type r) (evd : r Sigma.t) n c =
     if Int.equal n 0 then
       Sigma (c, evd, p)
     else
-      match kind_of_term (whd_betadeltaiota env (Sigma.to_evar_map evd) cty) with
+      match kind_of_term (whd_all env (Sigma.to_evar_map evd) cty) with
       | Prod (_,c1,c2) ->
         let Sigma (evar, evd', q) = Evarutil.new_evar env evd ~src:(Loc.ghost,Evar_kinds.GoalEvar) c1 in
 	  apprec (n-1) (mkApp(c,[|evar|])) (subst1 evar c2) (p +> q) evd'
@@ -1208,15 +1216,15 @@ let applyHead env (type r) (evd : r Sigma.t) n c =
 
 let is_mimick_head ts f =
   match kind_of_term f with
-  | Const (c,u) -> not (Closure.is_transparent_constant ts c)
-  | Var id -> not (Closure.is_transparent_variable ts id)
+  | Const (c,u) -> not (CClosure.is_transparent_constant ts c)
+  | Var id -> not (CClosure.is_transparent_variable ts id)
   | (Rel _|Construct _|Ind _) -> true
   | _ -> false
 
 let try_to_coerce env evd c cty tycon =
   let j = make_judge c cty in
   let (evd',j') = inh_conv_coerce_rigid_to true Loc.ghost env evd j tycon in
-  let evd' = Evarconv.consider_remaining_unif_problems env evd' in
+  let evd' = Evarconv.solve_unif_constraints_with_heuristics env evd' in
   let evd' = Evd.map_metas_fvalue (nf_evar evd') evd' in
     (evd',j'.uj_val)
 
@@ -1266,7 +1274,11 @@ let solve_simple_evar_eqn ts env evd ev rhs =
   | UnifFailure (evd,reason) ->
       error_cannot_unify env evd ~reason (mkEvar ev,rhs);
   | Success evd ->
-      Evarconv.consider_remaining_unif_problems env evd
+     if Flags.version_less_or_equal Flags.V8_5 then
+       (* We used to force solving unrelated problems at arbitrary times *)
+       Evarconv.solve_unif_constraints_with_heuristics env evd
+     else (* solve_simple_eqn calls reconsider_unif_constraints itself *)
+       evd
 
 (* [w_merge env sigma b metas evars] merges common instances in metas
    or in evars, possibly generating new unification problems; if [b]
@@ -1293,7 +1305,6 @@ let w_merge env with_types flags (evd,metas,evars) =
 	      if is_mimick_head flags.modulo_delta f then
 		let evd' =
 		  mimick_undefined_evar evd flags f (Array.length cl) evk in
-		(* let evd' = Evarconv.consider_remaining_unif_problems env evd' in *)
 		  w_merge_rec evd' metas evars eqns
 	      else
 		let evd' = 
@@ -1341,7 +1352,7 @@ let w_merge env with_types flags (evd,metas,evars) =
     	  else
             let evd' =
               if occur_meta_evd evd mv c then
-                if isMetaOf mv (whd_betadeltaiota env evd c) then evd
+                if isMetaOf mv (whd_all env evd c) then evd
                 else error_cannot_unify env evd (mkMeta mv,c)
               else
 	        meta_assign mv (c,(status,TypeProcessed)) evd in
@@ -1351,7 +1362,7 @@ let w_merge env with_types flags (evd,metas,evars) =
 	let rec process_eqns failures = function
 	  | (mv,status,c)::eqns ->
               (match (try Inl (unify_type env evd flags mv status c)
-		      with e when Errors.noncritical e -> Inr e)
+		      with e when CErrors.noncritical e -> Inr e)
 	       with 
 	       | Inr e -> process_eqns (((mv,status,c),e)::failures) eqns
 	       | Inl (evd,metas,evars) ->
@@ -1385,10 +1396,11 @@ let w_merge env with_types flags (evd,metas,evars) =
     in w_merge_rec evd [] [] eqns
   in
   let res =  (* merge constraints *)
-    w_merge_rec evd (order_metas metas) (List.rev evars) []
+    w_merge_rec evd (order_metas metas)
+                (* Assign evars in the order of assignments during unification *)
+                (List.rev evars) []
   in
-    if with_types then check_types res
-    else res
+  if with_types then check_types res else res
 
 let w_unify_meta_types env ?(flags=default_unify_flags ()) evd =
   let metas,evd = retract_coercible_metas evd in
@@ -1446,7 +1458,7 @@ let w_typed_unify_array env evd flags f1 l1 f2 l2 =
   let subst = Array.fold_left2 fold_subst subst l1 l2 in
   let evd = w_merge env true flags.merge_unify_flags subst in
   try_resolve_typeclasses env evd flags.resolve_evars
-    (mkApp(f1,l1)) (mkApp(f2,l2))
+                          (mkApp(f1,l1)) (mkApp(f2,l2))
 
 (* 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
@@ -1470,10 +1482,10 @@ let indirectly_dependent c d decls =
        it is needed otherwise, as e.g. when abstracting over "2" in
        "forall H:0=2, H=H:>(0=1+1) -> 0=2." where there is now obvious
        way to see that the second hypothesis depends indirectly over 2 *)
-    List.exists (fun d' -> dependent_in_decl (mkVar (get_id d')) d) decls
+    List.exists (fun d' -> dependent_in_decl (mkVar (NamedDecl.get_id d')) d) decls
 
 let indirect_dependency d decls =
-  decls  |>  List.filter (fun d' -> dependent_in_decl (mkVar (get_id d')) d)  |>  List.hd  |>  get_id
+  decls  |>  List.filter (fun d' -> dependent_in_decl (mkVar (NamedDecl.get_id d')) d)  |>  List.hd  |>  NamedDecl.get_id
 
 let finish_evar_resolution ?(flags=Pretyping.all_and_fail_flags) env current_sigma (pending,c) =
   let current_sigma = Sigma.to_evar_map current_sigma in
@@ -1553,7 +1565,7 @@ let make_pattern_test from_prefix_of_ind is_correct_type env sigma (pending,c) =
     | PretypeError (_,_,CannotUnify (c1,c2,Some e)) ->
         raise (NotUnifiable (Some (c1,c2,e)))
     (** MS: This is pretty bad, it catches Not_found for example *)
-    | e when Errors.noncritical e -> raise (NotUnifiable None) in
+    | e when CErrors.noncritical e -> raise (NotUnifiable None) in
   let merge_fun c1 c2 =
     match c1, c2 with
     | Some (evd,c1,x), Some (_,c2,_) ->
@@ -1583,8 +1595,8 @@ let make_abstraction_core name (test,out) env sigma c ty occs check_occs concl =
     let x = id_of_name_using_hdchar (Global.env()) t name in
     let ids = ids_of_named_context (named_context env) in
     if name == Anonymous then next_ident_away_in_goal x ids else
-    if mem_named_context x (named_context env) then
-      errorlabstrm "Unification.make_abstraction_core"
+    if mem_named_context_val x (named_context_val env) then
+      user_err ~hdr:"Unification.make_abstraction_core"
         (str "The variable " ++ Nameops.pr_id x ++ str " is already declared.")
     else
       x
@@ -1592,17 +1604,10 @@ let make_abstraction_core name (test,out) env sigma c ty occs check_occs concl =
   let likefirst = clause_with_generic_occurrences occs in
   let mkvarid () = mkVar id in
   let compute_dependency _ d (sign,depdecls) =
-    let hyp = get_id d in
+    let hyp = NamedDecl.get_id d in
     match occurrences_of_hyp hyp occs with
     | NoOccurrences, InHyp ->
-        if indirectly_dependent c d depdecls then
-          (* Told explicitly not to abstract over [d], but it is dependent *)
-          let id' = indirect_dependency d depdecls in
-          errorlabstrm "" (str "Cannot abstract over " ++ Nameops.pr_id id'
-            ++ str " without also abstracting or erasing " ++ Nameops.pr_id hyp
-            ++ str ".")
-        else
-          (push_named_context_val d sign,depdecls)
+        (push_named_context_val d sign,depdecls)
     | AllOccurrences, InHyp as occ ->
         let occ = if likefirst then LikeFirst else AtOccs occ in
         let newdecl = replace_term_occ_decl_modulo occ test mkvarid d in
@@ -1629,7 +1634,7 @@ let make_abstraction_core name (test,out) env sigma c ty occs check_occs concl =
           replace_term_occ_modulo occ test mkvarid concl
     in
     let lastlhyp =
-      if List.is_empty depdecls then None else Some (get_id (List.last depdecls)) in
+      if List.is_empty depdecls then None else Some (NamedDecl.get_id (List.last depdecls)) in
     let res = match out test with
     | None -> None
     | Some (sigma, c) -> Some (Sigma.Unsafe.of_pair (c, sigma))
@@ -1882,21 +1887,14 @@ let secondOrderAbstraction env evd flags typ (p, oplist) =
     error_wrong_abstraction_type env evd'
       (Evd.meta_name evd p) pred typp predtyp;
   w_merge env false flags.merge_unify_flags
-    (evd',[p,pred,(Conv,TypeProcessed)],[])
-
-  (* let evd',metas,evars =  *)
-  (*   try unify_0 env evd' CUMUL flags predtyp typp  *)
-  (*   with NotConvertible -> *)
-  (*     error_wrong_abstraction_type env evd *)
-  (*       (Evd.meta_name evd p) pred typp predtyp *)
-  (* in *)
-  (*   w_merge env false flags (evd',(p,pred,(Conv,TypeProcessed))::metas,evars) *)
+          (evd',[p,pred,(Conv,TypeProcessed)],[])
 
 let secondOrderDependentAbstraction env evd flags typ (p, oplist) =
   let typp = Typing.meta_type evd p in
   let evd, pred = abstract_list_all_with_dependencies env evd typp typ oplist in
   w_merge env false flags.merge_unify_flags
-    (evd,[p,pred,(Conv,TypeProcessed)],[])
+          (evd,[p,pred,(Conv,TypeProcessed)],[])
+
 
 let secondOrderAbstractionAlgo dep =
   if dep then secondOrderDependentAbstraction else secondOrderAbstraction
diff --git a/pretyping/vnorm.ml b/pretyping/vnorm.ml
index 7ea9b9063..75159bf8b 100644
--- a/pretyping/vnorm.ml
+++ b/pretyping/vnorm.ml
@@ -17,6 +17,9 @@ open Reduction
 open Vm
 open Context.Rel.Declaration
 
+module RelDecl = Context.Rel.Declaration
+module NamedDecl = Context.Named.Declaration
+
 (*******************************************)
 (* Calcul de la forme normal d'un terme    *)
 (*******************************************)
@@ -24,7 +27,7 @@ open Context.Rel.Declaration
 let crazy_type =  mkSet
 
 let decompose_prod env t =
-  let (name,dom,codom as res) = destProd (whd_betadeltaiota env t) in
+  let (name,dom,codom as res) = destProd (whd_all env t) in
   match name with
   | Anonymous -> (Name (Id.of_string "x"), dom, codom)
   | Name _ -> res
@@ -46,7 +49,11 @@ let invert_tag cst tag reloc_tbl =
   with Find_at j -> (j+1)
              (* Argggg, ces constructeurs de ... qui commencent a 1*)
 
-let find_rectype_a env c = Inductiveops.find_mrectype_vect env Evd.empty c
+let find_rectype_a env c =
+  let (t, l) = decompose_appvect (whd_all env c) in
+  match kind_of_term t with
+  | Ind ind -> (ind, l)
+  | _ -> assert false
 
 (* Instantiate inductives and parameters in constructor type *)
 
@@ -203,12 +210,11 @@ and constr_type_of_idkey env (idkey : Vars.id_key) stk =
      in
      nf_univ_args ~nb_univs mk env stk
    | VarKey id ->
-      let open Context.Named.Declaration in
-      let ty = get_type (lookup_named id env) in
+      let ty = NamedDecl.get_type (lookup_named id env) in
       nf_stk env (mkVar id) ty stk
   | RelKey i ->
       let n = (nb_rel env - i) in
-      let ty = get_type (lookup_rel n env) in
+      let ty = RelDecl.get_type (lookup_rel n env) in
       nf_stk env (mkRel n) (lift n ty) stk
 
 and nf_stk ?from:(from=0) env c t stk  =
@@ -234,7 +240,7 @@ and nf_stk ?from:(from=0) env c t stk  =
       let params,realargs = Util.Array.chop nparams allargs in
       let pT =
 	hnf_prod_applist env (type_of_ind env (ind,u)) (Array.to_list params) in
-      let pT = whd_betadeltaiota env pT in
+      let pT = whd_all env pT in
       let dep, p = nf_predicate env (ind,u) mip params (type_of_switch sw) pT in
       (* Calcul du type des branches *)
       let btypes = build_branches_type env ind mib mip u params dep p in
@@ -305,7 +311,7 @@ and nf_fun env f typ =
     try decompose_prod env typ
     with DestKO ->
       (* 27/2/13: Turned this into an anomaly *)
-      Errors.anomaly
+      CErrors.anomaly
         (Pp.strbrk "Returned a functional value in a type not recognized as a product type.")
   in
   let body = nf_val (push_rel (LocalAssum (name,dom)) env) vb codom in
diff --git a/printing/genprint.ml b/printing/genprint.ml
index 0ec35e07b..6505a8f82 100644
--- a/printing/genprint.ml
+++ b/printing/genprint.ml
@@ -9,15 +9,17 @@
 open Pp
 open Genarg
 
-type ('raw, 'glb, 'top) printer = {
-  raw : 'raw -> std_ppcmds;
-  glb : 'glb -> std_ppcmds;
-  top : 'top -> std_ppcmds;
+type 'a printer = 'a -> std_ppcmds
+
+type ('raw, 'glb, 'top) genprinter = {
+  raw : 'raw printer;
+  glb : 'glb printer;
+  top : 'top printer;
 }
 
 module PrintObj =
 struct
-  type ('raw, 'glb, 'top) obj = ('raw, 'glb, 'top) printer
+  type ('raw, 'glb, 'top) obj = ('raw, 'glb, 'top) genprinter
   let name = "printer"
   let default wit = match wit with
   | ExtraArg tag ->
diff --git a/printing/genprint.mli b/printing/genprint.mli
index 6e6626f2f..5381fc5bd 100644
--- a/printing/genprint.mli
+++ b/printing/genprint.mli
@@ -11,6 +11,8 @@
 open Pp
 open Genarg
 
+type 'a printer = 'a -> std_ppcmds
+
 val raw_print : ('raw, 'glb, 'top) genarg_type -> 'raw -> std_ppcmds
 (** Printer for raw level generic arguments. *)
 
@@ -20,9 +22,9 @@ val glb_print : ('raw, 'glb, 'top) genarg_type -> 'glb -> std_ppcmds
 val top_print : ('raw, 'glb, 'top) genarg_type -> 'top -> std_ppcmds
 (** Printer for top level generic arguments. *)
 
-val generic_raw_print : rlevel generic_argument -> std_ppcmds
-val generic_glb_print : glevel generic_argument -> std_ppcmds
-val generic_top_print : tlevel generic_argument -> std_ppcmds
+val generic_raw_print : rlevel generic_argument printer
+val generic_glb_print : glevel generic_argument printer
+val generic_top_print : tlevel generic_argument printer
 
 val register_print0 : ('raw, 'glb, 'top) genarg_type ->
-  ('raw -> std_ppcmds) -> ('glb -> std_ppcmds) -> ('top -> std_ppcmds) -> unit
+  'raw printer -> 'glb printer -> 'top printer -> unit
diff --git a/printing/miscprint.ml b/printing/miscprint.ml
index 5e86c6bd7..7b2c5695f 100644
--- a/printing/miscprint.ml
+++ b/printing/miscprint.ml
@@ -28,7 +28,7 @@ and pr_intro_pattern_action prc = function
   | IntroInjection pl ->
       str "[=" ++ hv 0 (prlist_with_sep spc (pr_intro_pattern prc) pl) ++
       str "]"
-  | IntroApplyOn (c,pat) -> pr_intro_pattern prc pat ++ str "/" ++ prc c
+  | IntroApplyOn (c,pat) -> pr_intro_pattern prc pat ++ str "%" ++ prc c
   | IntroRewrite true -> str "->"
   | IntroRewrite false -> str "<-"
 
diff --git a/printing/ppannotation.ml b/printing/ppannotation.ml
index 511f93569..726c0ffcf 100644
--- a/printing/ppannotation.ml
+++ b/printing/ppannotation.ml
@@ -9,29 +9,23 @@
 open Ppextend
 open Constrexpr
 open Vernacexpr
-open Tacexpr
+open Genarg
 
 type t =
   | AKeyword
   | AUnparsing            of unparsing
   | AConstrExpr           of constr_expr
   | AVernac               of vernac_expr
-  | AGlobTacticExpr       of glob_tactic_expr
-  | AGlobAtomicTacticExpr of glob_atomic_tactic_expr
-  | ARawTacticExpr        of raw_tactic_expr
-  | ARawAtomicTacticExpr  of raw_atomic_tactic_expr
-  | AAtomicTacticExpr     of atomic_tactic_expr
+  | AGlbGenArg            of glob_generic_argument
+  | ARawGenArg            of raw_generic_argument
 
 let tag_of_annotation = function
   | AKeyword                -> "keyword"
   | AUnparsing _            -> "unparsing"
   | AConstrExpr _           -> "constr_expr"
   | AVernac _               -> "vernac_expr"
-  | AGlobTacticExpr _       -> "glob_tactic_expr"
-  | AGlobAtomicTacticExpr _ -> "glob_atomic_tactic_expr"
-  | ARawTacticExpr _        -> "raw_tactic_expr"
-  | ARawAtomicTacticExpr _  -> "raw_atomic_tactic_expr"
-  | AAtomicTacticExpr _     -> "atomic_tactic_expr"
+  | AGlbGenArg _            -> "glob_generic_argument"
+  | ARawGenArg _            -> "raw_generic_argument"
 
 let attributes_of_annotation a =
   []
diff --git a/printing/ppannotation.mli b/printing/ppannotation.mli
index a0fef1a75..b0e0facef 100644
--- a/printing/ppannotation.mli
+++ b/printing/ppannotation.mli
@@ -12,18 +12,15 @@
 open Ppextend
 open Constrexpr
 open Vernacexpr
-open Tacexpr
+open Genarg
 
 type t =
   | AKeyword
   | AUnparsing            of unparsing
   | AConstrExpr           of constr_expr
   | AVernac               of vernac_expr
-  | AGlobTacticExpr       of glob_tactic_expr
-  | AGlobAtomicTacticExpr of glob_atomic_tactic_expr
-  | ARawTacticExpr        of raw_tactic_expr
-  | ARawAtomicTacticExpr  of raw_atomic_tactic_expr
-  | AAtomicTacticExpr     of atomic_tactic_expr
+  | AGlbGenArg            of glob_generic_argument
+  | ARawGenArg            of raw_generic_argument
 
 val tag_of_annotation : t -> string
 
diff --git a/printing/ppconstr.ml b/printing/ppconstr.ml
index 1866ca504..80ddd669f 100644
--- a/printing/ppconstr.ml
+++ b/printing/ppconstr.ml
@@ -7,7 +7,7 @@
 (************************************************************************)
 
 (*i*)
-open Errors
+open CErrors
 open Util
 open Pp
 open Names
@@ -129,7 +129,7 @@ end) = struct
     str "`" ++ str hd ++ c ++ str tl
 
   let pr_com_at n =
-    if Flags.do_beautify() && not (Int.equal n 0) then comment n
+    if !Flags.beautify && not (Int.equal n 0) then comment (CLexer.extract_comments n)
     else mt()
 
   let pr_with_comments loc pp = pr_located (fun x -> x) (loc,pp)
@@ -149,6 +149,12 @@ end) = struct
     | GType [] -> tag_type (str "Type")
     | GType u -> hov 0 (tag_type (str "Type") ++ pr_univ_annot pr_univ u)
 
+  let pr_glob_level = function
+    | GProp -> tag_type (str "Prop")
+    | GSet -> tag_type (str "Set")
+    | GType None -> tag_type (str "Type")
+    | GType (Some (_, u)) -> tag_type (str u)
+
   let pr_qualid sp =
     let (sl, id) = repr_qualid sp in
     let id = tag_ref (pr_id id) in
@@ -279,6 +285,8 @@ end) = struct
 
       | CPatDelimiters (_,k,p) ->
         pr_delimiters k (pr_patt mt lsimplepatt p), 1
+      | CPatCast _ ->
+        assert false
     in
     let loc = cases_pattern_expr_loc p in
     pr_with_comments loc
@@ -298,6 +306,7 @@ end) = struct
   let begin_of_binder = function
   LocalRawDef((loc,_),_) -> fst (Loc.unloc loc)
     | LocalRawAssum((loc,_)::_,_,_) -> fst (Loc.unloc loc)
+    | LocalPattern(loc,_,_) -> fst (Loc.unloc loc)
     | _ -> assert false
 
   let begin_of_binders = function
@@ -346,6 +355,13 @@ end) = struct
         | _ -> c, CHole (Loc.ghost, None, Misctypes.IntroAnonymous, None) in
       surround (pr_lname na ++ pr_opt_type pr_c topt ++
                   str":=" ++ cut() ++ pr_c c)
+    | LocalPattern (loc,p,tyo) ->
+      let p = pr_patt lsimplepatt p in
+      match tyo with
+        | None ->
+          str "'" ++ p
+        | Some ty ->
+          str "'" ++ surround (p ++ spc () ++ str ":" ++ ws 1 ++ pr_c ty)
 
   let pr_undelimited_binders sep pr_c =
     prlist_with_sep sep (pr_binder_among_many pr_c)
@@ -354,13 +370,13 @@ end) = struct
     let n = begin_of_binders bl in
     match bl with
       | [LocalRawAssum (nal,k,t)] ->
-        pr_com_at n ++ kw() ++ pr_binder false pr_c (nal,k,t)
-      | LocalRawAssum _ :: _ as bdl ->
-        pr_com_at n ++ kw() ++ pr_undelimited_binders sep pr_c bdl
+        kw n ++ pr_binder false pr_c (nal,k,t)
+      | (LocalRawAssum _ | LocalPattern _) :: _ as bdl ->
+        kw n ++ pr_undelimited_binders sep pr_c bdl
       | _ -> assert false
 
   let pr_binders_gen pr_c sep is_open =
-    if is_open then pr_delimited_binders mt sep pr_c
+    if is_open then pr_delimited_binders pr_com_at sep pr_c
     else pr_undelimited_binders sep pr_c
 
   let rec extract_prod_binders = function
@@ -369,6 +385,11 @@ end) = struct
       if bl = [] then [], x else LocalRawDef (na,b) :: bl, c*)
     | CProdN (loc,[],c) ->
       extract_prod_binders c
+    | CProdN (loc,[[_,Name id],bk,t],
+              CCases (_,LetPatternStyle,None, [CRef (Ident (_,id'),None),None,None],[(_,[_,[p]],b)]))
+         when Id.equal id id' && not (Id.Set.mem id (Topconstr.free_vars_of_constr_expr b)) ->
+      let bl,c = extract_prod_binders b in
+      LocalPattern (loc,p,None) :: bl, c
     | CProdN (loc,(nal,bk,t)::bl,c) ->
       let bl,c = extract_prod_binders (CProdN(loc,bl,c)) in
       LocalRawAssum (nal,bk,t) :: bl, c
@@ -380,6 +401,11 @@ end) = struct
       if bl = [] then [], x else LocalRawDef (na,b) :: bl, c*)
     | CLambdaN (loc,[],c) ->
       extract_lam_binders c
+    | CLambdaN (loc,[[_,Name id],bk,t],
+                CCases (_,LetPatternStyle,None, [CRef (Ident (_,id'),None),None,None],[(_,[_,[p]],b)]))
+         when Id.equal id id' && not (Id.Set.mem id (Topconstr.free_vars_of_constr_expr b)) ->
+      let bl,c = extract_lam_binders b in
+      LocalPattern (loc,p,None) :: bl, c
     | CLambdaN (loc,(nal,bk,t)::bl,c) ->
       let bl,c = extract_lam_binders (CLambdaN(loc,bl,c)) in
       LocalRawAssum (nal,bk,t) :: bl, c
@@ -416,7 +442,7 @@ end) = struct
   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" " ++
+    pr_id id ++ (if bl = [] then mt () else str" ") ++
       hov 0 (pr_undelimited_binders spc (pr ltop) bl ++ annot) ++
       pr_opt_type_spc pr t ++ str " :=" ++
       pr_sep_com (fun () -> brk(1,2)) (pr_body ltop) c
@@ -430,6 +456,7 @@ end) = struct
             let names_of_binder = function
               | LocalRawAssum (nal,_,_) -> nal
               | LocalRawDef (_,_) -> []
+              | LocalPattern _ -> assert false
             in let ids = List.flatten (List.map names_of_binder bl) in
                if List.length ids > 1 then
                  spc() ++ str "{" ++ keyword "struct" ++ spc () ++ pr_id id ++ str"}"
@@ -493,9 +520,14 @@ end) = struct
       pr (lapp,L) a  ++
         prlist (fun a -> spc () ++ pr_expl_args pr a) l)
 
-  let pr_forall () = keyword "forall" ++ spc ()
+  let pr_record_body_gen pr l =
+    spc () ++
+    prlist_with_sep pr_semicolon
+      (fun (id, c) -> h 1 (pr_reference id ++ spc () ++ str":=" ++ pr ltop c)) l
 
-  let pr_fun () = keyword "fun" ++ spc ()
+  let pr_forall n = keyword "forall" ++ pr_com_at n ++ spc ()
+
+  let pr_fun n = keyword "fun" ++ pr_com_at n ++ spc ()
 
   let pr_fun_sep = spc () ++ str "=>"
 
@@ -595,10 +627,7 @@ end) = struct
         return (pr_app (pr mt) a l, lapp)
       | CRecord (_,l) ->
         return (
-          hv 0 (str"{|" ++ spc () ++
-                  prlist_with_sep pr_semicolon
-                  (fun (id, c) -> h 1 (pr_reference id ++ spc () ++ str":=" ++ pr spc ltop c)) l
-                ++ str" |}"),
+          hv 0 (str"{|" ++ pr_record_body_gen (pr spc) l ++ str" |}"),
           latom
         )
       | CCases (_,LetPatternStyle,rtntypopt,[c,as_clause,in_clause],[(_,[(loc,[p])],b)]) ->
@@ -731,6 +760,8 @@ end) = struct
 
   let pr_cases_pattern_expr = pr_patt ltop
 
+  let pr_record_body = pr_record_body_gen pr
+
   let pr_binders = pr_undelimited_binders spc (pr ltop)
 
 end
@@ -768,6 +799,22 @@ end
 
 let do_not_tag _ x = x
 
+let split_token tag s =
+  let len = String.length s in
+  let rec parse_string off i =
+    if Int.equal i len then
+      if Int.equal off i then mt () else tag (str (String.sub s off (i - off)))
+    else if s.[i] == ' ' then
+      if Int.equal off i then parse_space 1 (succ i)
+      else tag (str (String.sub s off (i - off))) ++ parse_space 1 (succ i)
+    else parse_string off (succ i)
+  and parse_space spc i =
+    if Int.equal i len then str (String.make spc ' ')
+    else if s.[i] == ' ' then parse_space (succ spc) (succ i)
+    else str (String.make spc ' ') ++ parse_string i (succ i)
+  in
+  parse_string 0 0
+
 (** Instantiating Make with tagging functions that only add style
     information. *)
 include Make (struct
@@ -776,7 +823,7 @@ include Make (struct
     let tag_evar        = tag Tag.evar
     let tag_type        = tag Tag.univ
     let tag_unparsing   = function
-    | UnpTerminal s -> tag Tag.notation
+    | UnpTerminal s -> fun _ -> split_token (fun pp -> tag Tag.notation pp) s
     | _ -> do_not_tag ()
     let tag_constr_expr = do_not_tag
     let tag_path = tag Tag.path
diff --git a/printing/ppconstrsig.mli b/printing/ppconstrsig.mli
index c711dd8f7..3de0d805c 100644
--- a/printing/ppconstrsig.mli
+++ b/printing/ppconstrsig.mli
@@ -44,12 +44,14 @@ module type Pp = sig
   val pr_qualid : qualid -> std_ppcmds
   val pr_patvar : patvar -> std_ppcmds
 
+  val pr_glob_level : glob_level -> std_ppcmds
   val pr_glob_sort : glob_sort -> std_ppcmds
   val pr_guard_annot : (constr_expr -> std_ppcmds) ->
     local_binder list ->
     ('a * Names.Id.t) option * recursion_order_expr ->
     std_ppcmds
 
+  val pr_record_body : (reference * constr_expr) list -> std_ppcmds
   val pr_binders : local_binder list -> std_ppcmds
   val pr_constr_pattern_expr : constr_pattern_expr -> std_ppcmds
   val pr_lconstr_pattern_expr : constr_pattern_expr -> std_ppcmds
diff --git a/printing/pputils.ml b/printing/pputils.ml
index 906b463a8..50630fb9b 100644
--- a/printing/pputils.ml
+++ b/printing/pputils.ml
@@ -6,10 +6,147 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
+open Util
 open Pp
+open Genarg
+open Nameops
+open Misctypes
+open Locus
+open Genredexpr
 
 let pr_located pr (loc, x) =
-  if Flags.do_beautify () && loc <> Loc.ghost then
+  if !Flags.beautify && loc <> Loc.ghost then
     let (b, e) = Loc.unloc loc in
-    Pp.comment b ++ pr x ++ Pp.comment e
+    (* Side-effect: order matters *)
+    let before = Pp.comment (CLexer.extract_comments b) in
+    let x = pr x in
+    let after = Pp.comment (CLexer.extract_comments e) in
+    before ++ x ++ after
   else pr x
+
+let pr_or_var pr = function
+  | ArgArg x -> pr x
+  | ArgVar (_,s) -> pr_id s
+
+let pr_with_occurrences pr keyword (occs,c) =
+  match occs with
+    | AllOccurrences ->
+      pr c
+    | NoOccurrences ->
+      failwith "pr_with_occurrences: no occurrences"
+    | OnlyOccurrences nl ->
+      hov 1 (pr c ++ spc () ++ keyword "at" ++ spc () ++
+                hov 0 (prlist_with_sep spc (pr_or_var int) nl))
+    | AllOccurrencesBut nl ->
+      hov 1 (pr c ++ spc () ++ keyword "at" ++ str" - " ++
+                hov 0 (prlist_with_sep spc (pr_or_var int) nl))
+
+exception ComplexRedFlag
+
+let pr_short_red_flag pr r =
+  if not r.rBeta ||  not r.rMatch || not r.rFix || not r.rCofix || not r.rZeta then
+    raise ComplexRedFlag
+  else if List.is_empty r.rConst then
+    if r.rDelta then mt () else raise ComplexRedFlag
+  else (if r.rDelta then str "-" else mt ()) ++
+          hov 0 (str "[" ++ prlist_with_sep spc pr r.rConst ++ str "]")
+
+let pr_red_flag pr r =
+  try pr_short_red_flag pr r
+  with complexRedFlags ->
+    (if r.rBeta then pr_arg str "beta" else mt ()) ++
+      (if r.rMatch && r.rFix && r.rCofix then pr_arg str "iota" else
+          (if r.rMatch then pr_arg str "match" else mt ()) ++
+          (if r.rFix then pr_arg str "fix" else mt ()) ++
+          (if r.rCofix then pr_arg str "cofix" else mt ())) ++
+      (if r.rZeta then pr_arg str "zeta" else mt ()) ++
+      (if List.is_empty 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 "]"))
+
+let pr_union pr1 pr2 = function
+  | Inl a -> pr1 a
+  | Inr b -> pr2 b
+
+let pr_red_expr (pr_constr,pr_lconstr,pr_ref,pr_pattern) keyword = function
+  | Red false -> keyword "red"
+  | Hnf -> keyword "hnf"
+  | Simpl (f,o) -> keyword "simpl" ++ (pr_short_red_flag pr_ref f)
+                    ++ pr_opt (pr_with_occurrences (pr_union pr_ref pr_pattern) keyword) o
+  | Cbv f ->
+    if f.rBeta && f.rMatch && f.rFix && f.rCofix &&
+          f.rZeta && f.rDelta && List.is_empty f.rConst then
+      keyword "compute"
+    else
+      hov 1 (keyword "cbv" ++ pr_red_flag pr_ref f)
+  | Lazy f ->
+    hov 1 (keyword "lazy" ++ pr_red_flag pr_ref f)
+  | Cbn f ->
+    hov 1 (keyword "cbn" ++ pr_red_flag pr_ref f)
+  | Unfold l ->
+    hov 1 (keyword "unfold" ++ spc() ++
+              prlist_with_sep pr_comma (pr_with_occurrences pr_ref keyword) l)
+  | Fold l -> hov 1 (keyword "fold" ++ prlist (pr_arg pr_constr) l)
+  | Pattern l ->
+    hov 1 (keyword "pattern" ++
+              pr_arg (prlist_with_sep pr_comma (pr_with_occurrences pr_constr keyword)) l)
+
+  | Red true ->
+    CErrors.error "Shouldn't be accessible from user."
+  | ExtraRedExpr s ->
+    str s
+  | CbvVm o ->
+    keyword "vm_compute" ++ pr_opt (pr_with_occurrences (pr_union pr_ref pr_pattern) keyword) o
+  | CbvNative o ->
+    keyword "native_compute" ++ pr_opt (pr_with_occurrences (pr_union pr_ref pr_pattern) keyword) o
+
+let pr_or_by_notation f = function
+  | AN v -> f v
+  | ByNotation (_,s,sc) -> qs s ++ pr_opt (fun sc -> str "%" ++ str sc) sc
+
+let hov_if_not_empty n p = if Pp.ismt p then p else hov n p
+
+let rec pr_raw_generic env (GenArg (Rawwit wit, x)) =
+  match wit with
+    | ListArg wit ->
+      let map x = pr_raw_generic env (in_gen (rawwit wit) x) in
+      let ans = pr_sequence map x in
+      hov_if_not_empty 0 ans
+    | OptArg wit ->
+      let ans = match x with
+        | None -> mt ()
+        | Some x -> pr_raw_generic env (in_gen (rawwit wit) x)
+      in
+      hov_if_not_empty 0 ans
+    | PairArg (wit1, wit2) ->
+      let p, q = x in
+      let p = in_gen (rawwit wit1) p in
+      let q = in_gen (rawwit wit2) q in
+      hov_if_not_empty 0 (pr_sequence (pr_raw_generic env) [p; q])
+    | ExtraArg s ->
+      Genprint.generic_raw_print (in_gen (rawwit wit) x)
+
+
+let rec pr_glb_generic env (GenArg (Glbwit wit, x)) =
+  match wit with
+    | ListArg wit ->
+      let map x = pr_glb_generic env (in_gen (glbwit wit) x) in
+      let ans = pr_sequence map x in
+      hov_if_not_empty 0 ans
+    | OptArg wit ->
+      let ans = match x with
+        | None -> mt ()
+        | Some x -> pr_glb_generic env (in_gen (glbwit wit) x)
+      in
+      hov_if_not_empty 0 ans
+    | PairArg (wit1, wit2) ->
+      let p, q = x in
+      let p = in_gen (glbwit wit1) p in
+      let q = in_gen (glbwit wit2) q in
+      let ans = pr_sequence (pr_glb_generic env) [p; q] in
+      hov_if_not_empty 0 ans
+    | ExtraArg s ->
+      Genprint.generic_glb_print (in_gen (glbwit wit) x)
diff --git a/printing/pputils.mli b/printing/pputils.mli
index a0f2c7728..b236fed70 100644
--- a/printing/pputils.mli
+++ b/printing/pputils.mli
@@ -7,7 +7,25 @@
 (************************************************************************)
 
 open Pp
+open Genarg
+open Misctypes
+open Locus
+open Genredexpr
 
 val pr_located : ('a -> std_ppcmds) -> 'a Loc.located -> std_ppcmds
 (** Prints an object surrounded by its commented location *)
 
+val pr_or_var : ('a -> std_ppcmds) -> 'a or_var -> std_ppcmds
+val pr_or_by_notation : ('a -> std_ppcmds) -> 'a or_by_notation -> std_ppcmds
+val pr_with_occurrences :
+  ('a -> std_ppcmds) -> (string -> std_ppcmds) -> 'a with_occurrences -> std_ppcmds
+
+val pr_short_red_flag : ('a -> std_ppcmds) -> 'a glob_red_flag -> std_ppcmds
+val pr_red_flag : ('a -> std_ppcmds) -> 'a glob_red_flag -> std_ppcmds
+val pr_red_expr :
+  ('a -> std_ppcmds) * ('a -> std_ppcmds) * ('b -> std_ppcmds) * ('c -> std_ppcmds) ->
+  (string -> std_ppcmds) ->
+  ('a,'b,'c) red_expr_gen -> std_ppcmds
+
+val pr_raw_generic : Environ.env -> rlevel generic_argument -> std_ppcmds
+val pr_glb_generic : Environ.env -> glevel generic_argument -> std_ppcmds
diff --git a/printing/ppvernac.ml b/printing/ppvernac.ml
index 10b2bda05..ff72be90c 100644
--- a/printing/ppvernac.ml
+++ b/printing/ppvernac.ml
@@ -9,7 +9,7 @@
 open Pp
 open Names
 
-open Errors
+open CErrors
 open Util
 open Extend
 open Vernacexpr
@@ -21,7 +21,6 @@ open Decl_kinds
 
 module Make
   (Ppconstr : Ppconstrsig.Pp)
-  (Pptactic : Pptacticsig.Pp)
   (Taggers  : sig
     val tag_keyword : std_ppcmds -> std_ppcmds
     val tag_vernac  : vernac_expr -> std_ppcmds -> std_ppcmds
@@ -30,10 +29,11 @@ module Make
 
   open Taggers
   open Ppconstr
-  open Pptactic
 
   let keyword s = tag_keyword (str s)
 
+  let pr_constr = pr_constr_expr
+  let pr_lconstr = pr_lconstr_expr
   let pr_spc_lconstr = pr_sep_com spc pr_lconstr_expr
 
   let pr_lident (loc,id) =
@@ -65,7 +65,7 @@ module Make
     | (loc,Name id) -> pr_lident (loc,id)
     | lna -> pr_located pr_name lna
 
-  let pr_smart_global = pr_or_by_notation pr_reference
+  let pr_smart_global = Pputils.pr_or_by_notation pr_reference
 
   let pr_ltac_ref = Libnames.pr_reference
 
@@ -79,15 +79,11 @@ module Make
     | VernacEndSubproof -> str""
     | _ -> str"."
 
-  let pr_gen t = pr_raw_generic (Global.env ()) t
+  let pr_gen t = Pputils.pr_raw_generic (Global.env ()) t
 
   let sep = fun _ -> spc()
   let sep_v2 = fun _ -> str"," ++ spc()
 
-  let pr_ne_sep sep pr = function
-  [] -> mt()
-    | l -> sep() ++ pr l
-
   let pr_set_entry_type = function
     | ETName -> str"ident"
     | ETReference -> str"global"
@@ -163,14 +159,22 @@ module Make
     | HintsReference r -> pr_reference r
     | HintsConstr c -> pr_c c
 
+  let pr_hint_mode = function
+    | ModeInput -> str"+"
+    | ModeNoHeadEvar -> str"!"
+    | ModeOutput -> str"-"
+
+  let pr_hint_info pr_pat { hint_priority = pri; hint_pattern = pat } =
+    pr_opt (fun x -> str"|" ++ int x) pri ++
+    pr_opt (fun y -> (if Option.is_empty pri then str"| " else mt()) ++ pr_pat y) pat
+
   let pr_hints db h pr_c pr_pat =
     let opth = pr_opt_hintbases db  in
     let pph =
       match h with
         | HintsResolve l ->
           keyword "Resolve " ++ prlist_with_sep sep
-            (fun (pri, _, c) -> pr_reference_or_constr pr_c c ++
-              match pri with Some x -> spc () ++ str"(" ++ int x ++ str")" | None -> mt ())
+            (fun (info, _, c) -> pr_reference_or_constr pr_c c ++ pr_hint_info pr_pat info)
             l
         | HintsImmediate l ->
           keyword "Immediate" ++ spc() ++
@@ -184,15 +188,15 @@ module Make
         | HintsMode (m, l) ->
           keyword "Mode"
           ++ spc ()
-          ++ pr_reference m ++ spc() ++ prlist_with_sep spc
-            (fun b -> if b then str"+" else str"-") l
+          ++ pr_reference m ++ spc() ++
+            prlist_with_sep spc pr_hint_mode l
         | HintsConstructors c ->
           keyword "Constructors"
           ++ spc() ++ prlist_with_sep spc pr_reference c
         | HintsExtern (n,c,tac) ->
           let pat = match c with None -> mt () | Some pat -> pr_pat pat in
           keyword "Extern" ++ spc() ++ int n ++ spc() ++ pat ++ str" =>" ++
-            spc() ++ pr_raw_tactic tac
+            spc() ++ Pputils.pr_raw_generic (Global.env ()) tac
     in
     hov 2 (keyword "Hint "++ pph ++ opth)
 
@@ -225,6 +229,11 @@ module Make
     | NoInline -> str "[no inline]"
     | InlineAt i -> str "[inline at level " ++ int i ++ str "]"
 
+  let pr_assumption_inline = function
+    | DefaultInline -> str "Inline"
+    | NoInline -> mt ()
+    | InlineAt i -> str "Inline(" ++ int i ++ str ")"
+
   let pr_module_ast_inl leading_space pr_c (mast,inl) =
     pr_module_ast leading_space pr_c mast ++ pr_inline inl
 
@@ -254,11 +263,12 @@ module Make
     | _ as c -> brk(0,2) ++ str" :" ++ pr_c c
 
   let pr_decl_notation prc ((loc,ntn),c,scopt) =
-    fnl () ++ keyword "where " ++ qs ntn ++ str " := " ++ prc c ++
+    fnl () ++ keyword "where " ++ qs ntn ++ str " := "
+    ++ Flags.without_option Flags.beautify prc c ++
       pr_opt (fun sc -> str ": " ++ str sc) scopt
 
   let pr_binders_arg =
-    pr_ne_sep spc pr_binders
+    pr_non_empty_arg pr_binders
 
   let pr_and_type_binders_arg bl =
     pr_binders_arg bl
@@ -357,8 +367,9 @@ module Make
     | SetAssoc RightA -> keyword "right associativity"
     | SetAssoc NonA -> keyword "no associativity"
     | SetEntryType (x,typ) -> str x ++ spc() ++ pr_set_entry_type typ
-    | SetOnlyParsing Flags.Current -> keyword "only parsing"
-    | SetOnlyParsing v -> keyword("compat \"" ^ Flags.pr_version v ^ "\"")
+    | SetOnlyPrinting -> keyword "only printing"
+    | SetOnlyParsing -> keyword "only parsing"
+    | SetCompatVersion v -> keyword("compat \"" ^ Flags.pr_version v ^ "\"")
     | SetFormat("text",s) -> keyword "format " ++ pr_located qs s
     | SetFormat(k,s) -> keyword "format " ++ qs k ++ spc() ++ pr_located qs s
 
@@ -372,6 +383,14 @@ module Make
     | None -> mt ()
     | Some pl -> str"@{" ++ prlist_with_sep spc pr_lident pl ++ str"}"
 
+  let pr_rec_definition ((((loc,id),pl),ro,bl,type_,def),ntn) =
+    let pr_pure_lconstr c = Flags.without_option Flags.beautify pr_lconstr c in
+    let annot = pr_guard_annot pr_lconstr_expr bl ro in
+    pr_id id ++ pr_univs pl ++ pr_binders_arg bl ++ annot
+    ++ pr_type_option (fun c -> spc() ++ pr_lconstr_expr c) type_
+    ++ pr_opt (fun def -> str":=" ++ brk(1,2) ++ pr_pure_lconstr def) def
+    ++ prlist (pr_decl_notation pr_constr) ntn
+
   let pr_statement head (idpl,(bl,c,guard)) =
     assert (not (Option.is_empty idpl));
     let id, pl = Option.get idpl in
@@ -388,843 +407,847 @@ module Make
 (**************************************)
 (* Pretty printer for vernac commands *)
 (**************************************)
-  let make_pr_vernac pr_constr pr_lconstr =
-    let pr_constrarg c = spc () ++ pr_constr c in
-    let pr_lconstrarg c = spc () ++ pr_lconstr c in
-    let pr_intarg n = spc () ++ int n in
-    let pr_oc = function
-    None -> str" :"
-      | Some true -> str" :>"
-      | Some false -> str" :>>"
-    in
-    let pr_record_field ((x, pri), ntn) =
-      let prx = match x with
-        | (oc,AssumExpr (id,t)) ->
-          hov 1 (pr_lname id ++
-                   pr_oc oc ++ spc() ++
-                   pr_lconstr_expr t)
-        | (oc,DefExpr(id,b,opt)) -> (match opt with
-            | Some t ->
-              hov 1 (pr_lname id ++
-                       pr_oc oc ++ spc() ++
-                       pr_lconstr_expr t ++ str" :=" ++ pr_lconstr b)
-            | None ->
-              hov 1 (pr_lname id ++ str" :=" ++ spc() ++
-                       pr_lconstr b)) in
-      let prpri = match pri with None -> mt() | Some i -> str "| " ++ int i in
-      prx ++ prpri ++ prlist (pr_decl_notation pr_constr) ntn
-    in
-    let pr_record_decl b c fs =
-      pr_opt pr_lident c ++ (if c = None then str"{" else str" {") ++
-        hv 0 (prlist_with_sep pr_semicolon pr_record_field fs ++ str"}")
-    in
 
-    let pr_printable = function
-      | PrintFullContext ->
-        keyword "Print All"
-      | PrintSectionContext s ->
-        keyword "Print Section" ++ spc() ++ Libnames.pr_reference s
-      | PrintGrammar ent ->
-        keyword "Print Grammar" ++ spc() ++ str ent
-      | PrintLoadPath dir ->
-        keyword "Print LoadPath" ++ pr_opt pr_dirpath dir
-      | PrintModules ->
-        keyword "Print Modules"
-      | PrintMLLoadPath ->
-        keyword "Print ML Path"
-      | PrintMLModules ->
-        keyword "Print ML Modules"
-      | PrintDebugGC ->
-        keyword "Print ML GC"
-      | PrintGraph ->
-        keyword "Print Graph"
-      | PrintClasses ->
-        keyword "Print Classes"
-      | PrintTypeClasses ->
-        keyword "Print TypeClasses"
-      | PrintInstances qid ->
-        keyword "Print Instances" ++ spc () ++ pr_smart_global qid
-      | PrintCoercions ->
-        keyword "Print Coercions"
-      | PrintCoercionPaths (s,t) ->
-        keyword "Print Coercion Paths" ++ spc()
-        ++ pr_class_rawexpr s ++ spc()
-        ++ pr_class_rawexpr t
-      | PrintCanonicalConversions ->
-        keyword "Print Canonical Structures"
-      | PrintTables ->
-        keyword "Print Tables"
-      | PrintHintGoal ->
-        keyword "Print Hint"
-      | PrintHint qid ->
-        keyword "Print Hint" ++ spc () ++ pr_smart_global qid
-      | PrintHintDb ->
-        keyword "Print Hint *"
-      | PrintHintDbName s ->
-        keyword "Print HintDb" ++ spc () ++ str s
-      | PrintUniverses (b, fopt) ->
-        let cmd =
-          if b then "Print Sorted Universes"
-          else "Print Universes"
+  let pr_constrarg c = spc () ++ pr_constr c
+  let pr_lconstrarg c = spc () ++ pr_lconstr c
+  let pr_intarg n = spc () ++ int n
+
+  let pr_oc = function
+    | None -> str" :"
+    | Some true -> str" :>"
+    | Some false -> str" :>>"
+
+  let pr_record_field ((x, pri), ntn) =
+    let prx = match x with
+      | (oc,AssumExpr (id,t)) ->
+        hov 1 (pr_lname id ++
+                 pr_oc oc ++ spc() ++
+                 pr_lconstr_expr t)
+      | (oc,DefExpr(id,b,opt)) -> (match opt with
+          | Some t ->
+            hov 1 (pr_lname id ++
+                     pr_oc oc ++ spc() ++
+                     pr_lconstr_expr t ++ str" :=" ++ pr_lconstr b)
+          | None ->
+            hov 1 (pr_lname id ++ str" :=" ++ spc() ++
+                     pr_lconstr b)) in
+    let prpri = match pri with None -> mt() | Some i -> str "| " ++ int i in
+    prx ++ prpri ++ prlist (pr_decl_notation pr_constr) ntn
+
+  let pr_record_decl b c fs =
+    pr_opt pr_lident c ++ (if c = None then str"{" else str" {") ++
+      hv 0 (prlist_with_sep pr_semicolon pr_record_field fs ++ str"}")
+
+  let pr_printable = function
+    | PrintFullContext ->
+      keyword "Print All"
+    | PrintSectionContext s ->
+      keyword "Print Section" ++ spc() ++ Libnames.pr_reference s
+    | PrintGrammar ent ->
+      keyword "Print Grammar" ++ spc() ++ str ent
+    | PrintLoadPath dir ->
+      keyword "Print LoadPath" ++ pr_opt pr_dirpath dir
+    | PrintModules ->
+      keyword "Print Modules"
+    | PrintMLLoadPath ->
+      keyword "Print ML Path"
+    | PrintMLModules ->
+      keyword "Print ML Modules"
+    | PrintDebugGC ->
+      keyword "Print ML GC"
+    | PrintGraph ->
+      keyword "Print Graph"
+    | PrintClasses ->
+      keyword "Print Classes"
+    | PrintTypeClasses ->
+      keyword "Print TypeClasses"
+    | PrintInstances qid ->
+      keyword "Print Instances" ++ spc () ++ pr_smart_global qid
+    | PrintCoercions ->
+      keyword "Print Coercions"
+    | PrintCoercionPaths (s,t) ->
+      keyword "Print Coercion Paths" ++ spc()
+      ++ pr_class_rawexpr s ++ spc()
+      ++ pr_class_rawexpr t
+    | PrintCanonicalConversions ->
+      keyword "Print Canonical Structures"
+    | PrintTables ->
+      keyword "Print Tables"
+    | PrintHintGoal ->
+      keyword "Print Hint"
+    | PrintHint qid ->
+      keyword "Print Hint" ++ spc () ++ pr_smart_global qid
+    | PrintHintDb ->
+      keyword "Print Hint *"
+    | PrintHintDbName s ->
+      keyword "Print HintDb" ++ spc () ++ str s
+    | PrintUniverses (b, fopt) ->
+      let cmd =
+        if b then "Print Sorted Universes"
+        else "Print Universes"
+      in
+      keyword cmd ++ pr_opt str fopt
+    | PrintName qid ->
+      keyword "Print" ++ spc()  ++ pr_smart_global qid
+    | PrintModuleType qid ->
+      keyword "Print Module Type" ++ spc() ++ pr_reference qid
+    | PrintModule qid ->
+      keyword "Print Module" ++ spc() ++ pr_reference qid
+    | PrintInspect n ->
+      keyword "Inspect" ++ spc() ++ int n
+    | PrintScopes ->
+      keyword "Print Scopes"
+    | PrintScope s ->
+      keyword "Print Scope" ++ spc() ++ str s
+    | PrintVisibility s ->
+      keyword "Print Visibility" ++ pr_opt str s
+    | PrintAbout (qid,gopt) ->
+       pr_opt (fun g -> int g ++ str ":"++ spc()) gopt
+       ++ keyword "About" ++ spc()  ++ pr_smart_global qid
+    | PrintImplicit qid ->
+      keyword "Print Implicit" ++ spc()  ++ pr_smart_global qid
+    (* spiwack: command printing all the axioms and section variables used in a
+       term *)
+    | PrintAssumptions (b, t, qid) ->
+      let cmd = match b, t with
+        | true, true -> "Print All Dependencies"
+        | true, false -> "Print Opaque Dependencies"
+        | false, true -> "Print Transparent Dependencies"
+        | false, false -> "Print Assumptions"
+      in
+      keyword cmd ++ spc() ++ pr_smart_global qid
+    | PrintNamespace dp ->
+      keyword "Print Namespace" ++ pr_dirpath dp
+    | PrintStrategy None ->
+      keyword "Print Strategies"
+    | PrintStrategy (Some qid) ->
+      keyword "Print Strategy" ++ pr_smart_global qid
+
+  let pr_using e = str (Proof_using.to_string e)
+
+  let rec pr_vernac_body v =
+    let return = Taggers.tag_vernac v in
+    match v with
+      | VernacPolymorphic (poly, v) ->
+        let s = if poly then keyword "Polymorphic" else keyword "Monomorphic" in
+        return (s ++ spc () ++ pr_vernac_body v)
+      | VernacProgram v ->
+        return (keyword "Program" ++ spc() ++ pr_vernac_body v)
+      | VernacLocal (local, v) ->
+        return (pr_locality local ++ spc() ++ pr_vernac_body v)
+
+      (* Stm *)
+      | VernacStm JoinDocument ->
+        return (keyword "Stm JoinDocument")
+      | VernacStm PrintDag ->
+        return (keyword "Stm PrintDag")
+      | VernacStm Finish ->
+        return (keyword "Stm Finish")
+      | VernacStm Wait ->
+        return (keyword "Stm Wait")
+      | VernacStm (Observe id) ->
+        return (keyword "Stm Observe " ++ str(Stateid.to_string id))
+      | VernacStm (Command v) ->
+        return (keyword "Stm Command " ++ pr_vernac_body v)
+      | VernacStm (PGLast v) ->
+        return (keyword "Stm PGLast " ++ pr_vernac_body v)
+
+      (* Proof management *)
+      | VernacAbortAll ->
+        return (keyword "Abort All")
+      | VernacRestart ->
+        return (keyword "Restart")
+      | VernacUnfocus ->
+        return (keyword "Unfocus")
+      | VernacUnfocused ->
+        return (keyword "Unfocused")
+      | VernacGoal c ->
+        return (keyword "Goal" ++ pr_lconstrarg c)
+      | VernacAbort id ->
+        return (keyword "Abort" ++ pr_opt pr_lident id)
+      | VernacUndo i ->
+        return (
+          if Int.equal i 1 then keyword "Undo" else keyword "Undo" ++ pr_intarg i
+        )
+      | VernacUndoTo i ->
+        return (keyword "Undo" ++ spc() ++ keyword "To" ++ pr_intarg i)
+      | VernacBacktrack (i,j,k) ->
+        return (keyword "Backtrack" ++  spc() ++ prlist_with_sep sep int [i;j;k])
+      | VernacFocus i ->
+        return (keyword "Focus" ++ pr_opt int i)
+      | VernacShow s ->
+        let pr_goal_reference = function
+          | OpenSubgoals -> mt ()
+          | NthGoal n -> spc () ++ int n
+          | GoalId id -> spc () ++ pr_id id
+          | GoalUid n -> spc () ++ str n in
+        let pr_showable = function
+          | ShowGoal n -> keyword "Show" ++ pr_goal_reference n
+          | ShowGoalImplicitly n -> keyword "Show Implicit Arguments" ++ pr_opt int n
+          | ShowProof -> keyword "Show Proof"
+          | ShowNode -> keyword "Show Node"
+          | ShowScript -> keyword "Show Script"
+          | ShowExistentials -> keyword "Show Existentials"
+          | ShowUniverses -> keyword "Show Universes"
+          | ShowTree -> keyword "Show Tree"
+          | ShowProofNames -> keyword "Show Conjectures"
+          | ShowIntros b -> keyword "Show " ++ (if b then keyword "Intros" else keyword "Intro")
+          | ShowMatch id -> keyword "Show Match " ++ pr_reference id
+          | ShowThesis -> keyword "Show Thesis"
+        in
+        return (pr_showable s)
+      | VernacCheckGuard ->
+        return (keyword "Guarded")
+
+    (* Resetting *)
+      | VernacResetName id ->
+        return (keyword "Reset" ++ spc() ++ pr_lident id)
+      | VernacResetInitial ->
+        return (keyword "Reset Initial")
+      | VernacBack i ->
+        return (
+          if Int.equal i 1 then keyword "Back" else keyword "Back" ++ pr_intarg i
+        )
+      | VernacBackTo i ->
+        return (keyword "BackTo" ++ pr_intarg i)
+
+    (* State management *)
+      | VernacWriteState s ->
+        return (keyword "Write State" ++ spc () ++ qs s)
+      | VernacRestoreState s ->
+        return  (keyword "Restore State" ++ spc() ++ qs s)
+
+    (* Control *)
+      | VernacLoad (f,s) ->
+        return (
+          keyword "Load"
+          ++ if f then
+              (spc() ++ keyword "Verbose" ++ spc())
+            else
+              spc() ++ qs s
+        )
+      | VernacTime (_,v) ->
+        return (keyword "Time" ++ spc() ++ pr_vernac_body v)
+      | VernacRedirect (s, (_,v)) ->
+        return (keyword "Redirect" ++ spc() ++ qs s ++ spc() ++ pr_vernac_body v)
+      | VernacTimeout(n,v) ->
+        return (keyword "Timeout " ++ int n ++ spc() ++ pr_vernac_body v)
+      | VernacFail v ->
+        return (keyword "Fail" ++ spc() ++ pr_vernac_body v)
+      | VernacError _ ->
+        return (keyword "No-parsing-rule for VernacError")
+
+    (* Syntax *)
+      | VernacOpenCloseScope (_,(opening,sc)) ->
+        return (
+          keyword (if opening then "Open " else "Close ") ++
+            keyword "Scope" ++ spc() ++ str sc
+        )
+      | VernacDelimiters (sc,Some key) ->
+        return (
+          keyword "Delimit Scope" ++ spc () ++ str sc ++
+            spc() ++ keyword "with" ++ spc () ++ str key
+        )
+      | VernacDelimiters (sc, None) ->
+        return (
+          keyword "Undelimit Scope" ++ spc () ++ str sc
+        )
+      | VernacBindScope (sc,cll) ->
+        return (
+          keyword "Bind Scope" ++ spc () ++ str sc ++
+            spc() ++ keyword "with" ++ spc () ++ prlist_with_sep spc pr_class_rawexpr cll
+        )
+      | VernacArgumentsScope (q,scl) ->
+        let pr_opt_scope = function
+          | None -> str"_"
+          | Some sc -> str sc
+        in
+        return (
+          keyword "Arguments Scope"
+          ++ spc() ++ pr_smart_global q
+          ++ spc() ++ str"[" ++ prlist_with_sep sep pr_opt_scope scl ++ str"]"
+        )
+      | VernacInfix (_,((_,s),mv),q,sn) -> (* A Verifier *)
+        return (
+          hov 0 (hov 0 (keyword "Infix "
+                        ++ qs s ++ str " :=" ++ pr_constrarg q) ++
+                   pr_syntax_modifiers mv ++
+                   (match sn with
+                     | None -> mt()
+                     | Some sc -> spc() ++ str":" ++ spc() ++ str sc))
+        )
+      | VernacNotation (_,c,((_,s),l),opt) ->
+        return (
+          hov 2 (keyword "Notation" ++ spc() ++ qs s ++
+                   str " :=" ++ Flags.without_option Flags.beautify pr_constrarg c ++ pr_syntax_modifiers l ++
+                   (match opt with
+                     | None -> mt()
+                     | Some sc -> str" :" ++ spc() ++ str sc))
+        )
+      | VernacSyntaxExtension (_,(s,l)) ->
+        return (
+          keyword "Reserved Notation" ++ spc() ++ pr_located qs s ++
+            pr_syntax_modifiers l
+        )
+      | VernacNotationAddFormat(s,k,v) ->
+        return (
+          keyword "Format Notation " ++ qs s ++ spc () ++ qs k ++ spc() ++ qs v
+        )
+
+      (* Gallina *)
+      | VernacDefinition (d,id,b) -> (* A verifier... *)
+        let pr_def_token (l,dk) =
+          let l = match l with Some x -> x | None -> Decl_kinds.Global in
+          keyword (Kindops.string_of_definition_kind (l,false,dk))
         in
-        keyword cmd ++ pr_opt str fopt
-      | PrintName qid ->
-        keyword "Print" ++ spc()  ++ pr_smart_global qid
-      | PrintModuleType qid ->
-        keyword "Print Module Type" ++ spc() ++ pr_reference qid
-      | PrintModule qid ->
-        keyword "Print Module" ++ spc() ++ pr_reference qid
-      | PrintInspect n ->
-        keyword "Inspect" ++ spc() ++ int n
-      | PrintScopes ->
-        keyword "Print Scopes"
-      | PrintScope s ->
-        keyword "Print Scope" ++ spc() ++ str s
-      | PrintVisibility s ->
-        keyword "Print Visibility" ++ pr_opt str s
-      | PrintAbout (qid,gopt) ->
-         pr_opt (fun g -> int g ++ str ":"++ spc()) gopt
-	 ++ keyword "About" ++ spc()  ++ pr_smart_global qid
-      | PrintImplicit qid ->
-        keyword "Print Implicit" ++ spc()  ++ pr_smart_global qid
-      (* spiwack: command printing all the axioms and section variables used in a
-         term *)
-      | PrintAssumptions (b, t, qid) ->
-        let cmd = match b, t with
-          | true, true -> "Print All Dependencies"
-          | true, false -> "Print Opaque Dependencies"
-          | false, true -> "Print Transparent Dependencies"
-          | false, false -> "Print Assumptions"
+        let pr_reduce = function
+          | None -> mt()
+          | Some r ->
+            keyword "Eval" ++ spc() ++
+              pr_red_expr (pr_constr, pr_lconstr, pr_smart_global, pr_constr) keyword r ++
+              keyword " in" ++ spc()
         in
-        keyword cmd ++ spc() ++ pr_smart_global qid
-      | PrintNamespace dp ->
-        keyword "Print Namespace" ++ pr_dirpath dp
-      | PrintStrategy None ->
-        keyword "Print Strategies"
-      | PrintStrategy (Some qid) ->
-        keyword "Print Strategy" ++ pr_smart_global qid
-    in
+        let pr_def_body = function
+          | 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_binders_arg bl, str" :" ++ pr_spc_lconstr t, None) in
+        let (binds,typ,c) = pr_def_body b in
+        return (
+          hov 2 (
+            pr_def_token d ++ spc()
+            ++ pr_plident id ++ binds ++ typ
+            ++ (match c with
+              | None -> mt()
+              | Some cc -> str" :=" ++ spc() ++ cc))
+        )
+
+      | VernacStartTheoremProof (ki,l,_) ->
+        return (
+          hov 1 (pr_statement (pr_thm_token ki) (List.hd l) ++
+                   prlist (pr_statement (spc () ++ keyword "with")) (List.tl l))
+        )
+
+      | VernacEndProof Admitted ->
+        return (keyword "Admitted")
+
+      | VernacEndProof (Proved (opac,o)) -> return (
+        match o with
+          | None -> (match opac with
+              | Transparent -> keyword "Defined"
+              | Opaque None -> keyword "Qed"
+              | Opaque (Some l) ->
+                  keyword "Qed" ++ spc() ++ str"export" ++
+                    prlist_with_sep (fun () -> str", ") pr_lident l)
+          | Some (id,th) -> (match th with
+              | None -> (if opac <> Transparent then keyword "Save" else keyword "Defined") ++ spc() ++ pr_lident id
+              | Some tok -> keyword "Save" ++ spc() ++ pr_thm_token tok ++ spc() ++ pr_lident id)
+      )
+      | VernacExactProof c ->
+        return (hov 2 (keyword "Proof" ++ pr_lconstrarg c))
+      | VernacAssumption (stre,t,l) ->
+        let n = List.length (List.flatten (List.map fst (List.map snd l))) in
+        let pr_params (c, (xl, t)) =
+          hov 2 (prlist_with_sep sep pr_plident xl ++ spc() ++
+            (if c then str":>" else str":" ++ spc() ++ pr_lconstr_expr t)) in
+        let assumptions = prlist_with_sep spc (fun p -> hov 1 (str "(" ++ pr_params p ++ str ")")) l in
+        return (hov 2 (pr_assumption_token (n > 1) stre ++
+                       pr_non_empty_arg pr_assumption_inline t ++ spc() ++ assumptions))
+      | VernacInductive (p,f,l) ->
+        let pr_constructor (coe,(id,c)) =
+          hov 2 (pr_lident id ++ str" " ++
+                   (if coe then str":>" else str":") ++
+                   Flags.without_option Flags.beautify pr_spc_lconstr c)
+        in
+        let pr_constructor_list b l = match l with
+          | Constructors [] -> mt()
+          | Constructors l ->
+            let fst_sep = match l with [_] -> "   " | _ -> " | " in
+            pr_com_at (begin_of_inductive l) ++
+              fnl() ++ str fst_sep ++
+              prlist_with_sep (fun _ -> fnl() ++ str" | ") pr_constructor l
+          | RecordDecl (c,fs) ->
+            pr_record_decl b c fs
+        in
+        let pr_oneind key (((coe,(id,pl)),indpar,s,k,lc),ntn) =
+          hov 0 (
+            str key ++ spc() ++
+              (if coe then str"> " else str"") ++ pr_lident id ++ pr_univs pl ++
+              pr_and_type_binders_arg indpar ++
+              pr_opt (fun s -> str":" ++ spc() ++ pr_lconstr_expr s) s ++
+              str" :=") ++ pr_constructor_list k lc ++
+            prlist (pr_decl_notation pr_constr) ntn
+        in
+        let key =
+          let (_,_,_,k,_),_ = List.hd l in
+          match k with Record -> "Record" | Structure -> "Structure"
+            | Inductive_kw -> "Inductive" | CoInductive -> "CoInductive"
+            | Class _ -> "Class" | Variant -> "Variant"
+        in
+        return (
+          hov 1 (pr_oneind key (List.hd l)) ++
+            (prlist (fun ind -> fnl() ++ hov 1 (pr_oneind "with" ind)) (List.tl l))
+        )
+
+      | VernacFixpoint (local, recs) ->
+        let local = match local with
+          | Some Discharge -> "Let "
+          | Some Local -> "Local "
+          | None | Some Global -> ""
+        in
+        return (
+          hov 0 (str local ++ keyword "Fixpoint" ++ spc () ++
+                   prlist_with_sep (fun _ -> fnl () ++ keyword "with"
+                     ++ spc ()) pr_rec_definition recs)
+        )
+
+      | VernacCoFixpoint (local, corecs) ->
+        let local = match local with
+          | Some Discharge -> keyword "Let" ++ spc ()
+          | Some Local -> keyword "Local" ++ spc ()
+          | None | Some Global -> str ""
+        in
+        let pr_onecorec ((((loc,id),pl),bl,c,def),ntn) =
+          pr_id id ++ pr_univs pl ++ spc() ++ pr_binders bl ++ spc() ++ str":" ++
+            spc() ++ pr_lconstr_expr c ++
+            pr_opt (fun def -> str":=" ++ brk(1,2) ++ pr_lconstr def) def ++
+            prlist (pr_decl_notation pr_constr) ntn
+        in
+        return (
+          hov 0 (local ++ keyword "CoFixpoint" ++ spc() ++
+                   prlist_with_sep (fun _ -> fnl() ++ keyword "with" ++ spc ()) pr_onecorec corecs)
+        )
+      | VernacScheme l ->
+        return (
+          hov 2 (keyword "Scheme" ++ spc() ++
+                   prlist_with_sep (fun _ -> fnl() ++ keyword "with" ++ spc ()) pr_onescheme l)
+        )
+      | VernacCombinedScheme (id, l) ->
+        return (
+          hov 2 (keyword "Combined Scheme" ++ spc() ++
+                   pr_lident id ++ spc() ++ keyword "from" ++ spc() ++
+                   prlist_with_sep (fun _ -> fnl() ++ str", ") pr_lident l)
+        )
+      | VernacUniverse v ->
+        return (
+          hov 2 (keyword "Universe" ++ spc () ++
+                   prlist_with_sep (fun _ -> str",") pr_lident v)
+        )
+      | VernacConstraint v ->
+        let pr_uconstraint (l, d, r) =
+          pr_glob_level l ++ spc () ++ Univ.pr_constraint_type d ++ spc () ++
+            pr_glob_level r
+        in
+        return (
+          hov 2 (keyword "Constraint" ++ spc () ++
+                   prlist_with_sep (fun _ -> str",") pr_uconstraint v)
+        )
+
+      (* Gallina extensions *)
+      | VernacBeginSection id ->
+        return (hov 2 (keyword "Section" ++ spc () ++ pr_lident id))
+      | VernacEndSegment id ->
+        return (hov 2 (keyword "End" ++ spc() ++ pr_lident id))
+      | VernacNameSectionHypSet (id,set) ->
+        return (hov 2 (keyword "Package" ++ spc() ++ pr_lident id ++ spc()++
+        str ":="++spc()++pr_using set))
+      | VernacRequire (from, exp, l) ->
+        let from = match from with
+        | None -> mt ()
+        | Some r -> keyword "From" ++ spc () ++ pr_module r ++ spc ()
+        in
+        return (
+          hov 2
+            (from ++ keyword "Require" ++ spc() ++ pr_require_token exp ++
+               prlist_with_sep sep pr_module l)
+        )
+      | VernacImport (f,l) ->
+        return (
+          (if f then keyword "Export" else keyword "Import") ++ spc() ++
+            prlist_with_sep sep pr_import_module l
+        )
+      | VernacCanonical q ->
+        return (
+          keyword "Canonical Structure" ++ spc() ++ pr_smart_global q
+        )
+      | VernacCoercion (_,id,c1,c2) ->
+        return (
+          hov 1 (
+            keyword "Coercion" ++ spc() ++
+              pr_smart_global id ++ spc() ++ str":" ++ spc() ++ pr_class_rawexpr c1 ++
+              spc() ++ str">->" ++ spc() ++ pr_class_rawexpr c2)
+        )
+      | VernacIdentityCoercion (_,id,c1,c2) ->
+        return (
+          hov 1 (
+            keyword "Identity Coercion" ++ spc() ++ pr_lident id ++
+              spc() ++ str":" ++ spc() ++ pr_class_rawexpr c1 ++ spc() ++ str">->" ++
+              spc() ++ pr_class_rawexpr c2)
+        )
+
+      | VernacInstance (abst, sup, (instid, bk, cl), props, info) ->
+        return (
+          hov 1 (
+            (if abst then keyword "Declare" ++ spc () else mt ()) ++
+              keyword "Instance" ++
+              (match instid with
+      	 | (loc, Name id), l -> spc () ++ pr_plident ((loc, id),l) ++ spc () 
+               | (_, Anonymous), _ -> mt ()) ++
+              pr_and_type_binders_arg sup ++
+              str":" ++ spc () ++
+              (match bk with Implicit -> str "! " | Explicit -> mt ()) ++
+              pr_constr cl ++ pr_hint_info pr_constr_pattern_expr info ++
+              (match props with
+                | Some (true,CRecord (_,l)) -> spc () ++ str":=" ++ spc () ++ str"{" ++ pr_record_body l ++ str "}"
+                | Some (true,_) -> assert false
+                | Some (false,p) -> spc () ++ str":=" ++ spc () ++ pr_constr p
+                | None -> mt()))
+        )
+
+      | VernacContext l ->
+        return (
+          hov 1 (
+            keyword "Context" ++ pr_and_type_binders_arg l)
+        )
+
+      | VernacDeclareInstances insts ->
+         let pr_inst (id, info) =
+           pr_reference id ++ pr_hint_info pr_constr_pattern_expr info
+         in
+         return (
+          hov 1 (keyword "Existing" ++ spc () ++
+                   keyword(String.plural (List.length insts) "Instance") ++
+                 spc () ++ prlist_with_sep (fun () -> str", ") pr_inst insts)
+        )
+
+      | VernacDeclareClass id ->
+        return (
+          hov 1 (keyword "Existing" ++ spc () ++ keyword "Class" ++ spc () ++ pr_reference id)
+        )
 
-    let pr_using e = str (Proof_using.to_string e) in
-
-    let rec pr_vernac v =
-      let return = Taggers.tag_vernac v in
-      match v with
-        | VernacPolymorphic (poly, v) ->
-          let s = if poly then keyword "Polymorphic" else keyword "Monomorphic" in
-          return (s ++ pr_vernac v)
-        | VernacProgram v ->
-          return (keyword "Program" ++ spc() ++ pr_vernac v)
-        | VernacLocal (local, v) ->
-          return (pr_locality local ++ spc() ++ pr_vernac v)
-
-        (* Stm *)
-        | VernacStm JoinDocument ->
-          return (keyword "Stm JoinDocument")
-        | VernacStm PrintDag ->
-          return (keyword "Stm PrintDag")
-        | VernacStm Finish ->
-          return (keyword "Stm Finish")
-        | VernacStm Wait ->
-          return (keyword "Stm Wait")
-        | VernacStm (Observe id) ->
-          return (keyword "Stm Observe " ++ str(Stateid.to_string id))
-        | VernacStm (Command v) ->
-          return (keyword "Stm Command " ++ pr_vernac v)
-        | VernacStm (PGLast v) ->
-          return (keyword "Stm PGLast " ++ pr_vernac v)
-
-        (* Proof management *)
-        | VernacAbortAll ->
-          return (keyword "Abort All")
-        | VernacRestart ->
-          return (keyword "Restart")
-        | VernacUnfocus ->
-          return (keyword "Unfocus")
-        | VernacUnfocused ->
-          return (keyword "Unfocused")
-        | VernacGoal c ->
-          return (keyword "Goal" ++ pr_lconstrarg c)
-        | VernacAbort id ->
-          return (keyword "Abort" ++ pr_opt pr_lident id)
-        | VernacUndo i ->
-          return (
-            if Int.equal i 1 then keyword "Undo" else keyword "Undo" ++ pr_intarg i
-          )
-        | VernacUndoTo i ->
-          return (keyword "Undo" ++ spc() ++ keyword "To" ++ pr_intarg i)
-        | VernacBacktrack (i,j,k) ->
-          return (keyword "Backtrack" ++  spc() ++ prlist_with_sep sep int [i;j;k])
-        | VernacFocus i ->
-          return (keyword "Focus" ++ pr_opt int i)
-        | VernacShow s ->
-          let pr_goal_reference = function
-            | OpenSubgoals -> mt ()
-            | NthGoal n -> spc () ++ int n
-            | GoalId id -> spc () ++ pr_id id
-            | GoalUid n -> spc () ++ str n in
-          let pr_showable = function
-            | ShowGoal n -> keyword "Show" ++ pr_goal_reference n
-            | ShowGoalImplicitly n -> keyword "Show Implicit Arguments" ++ pr_opt int n
-            | ShowProof -> keyword "Show Proof"
-            | ShowNode -> keyword "Show Node"
-            | ShowScript -> keyword "Show Script"
-            | ShowExistentials -> keyword "Show Existentials"
-            | ShowUniverses -> keyword "Show Universes"
-            | ShowTree -> keyword "Show Tree"
-            | ShowProofNames -> keyword "Show Conjectures"
-            | ShowIntros b -> keyword "Show " ++ (if b then keyword "Intros" else keyword "Intro")
-            | ShowMatch id -> keyword "Show Match " ++ pr_lident id
-            | ShowThesis -> keyword "Show Thesis"
-          in
-          return (pr_showable s)
-        | VernacCheckGuard ->
-          return (keyword "Guarded")
-
-      (* Resetting *)
-        | VernacResetName id ->
-          return (keyword "Reset" ++ spc() ++ pr_lident id)
-        | VernacResetInitial ->
-          return (keyword "Reset Initial")
-        | VernacBack i ->
-          return (
-            if Int.equal i 1 then keyword "Back" else keyword "Back" ++ pr_intarg i
-          )
-        | VernacBackTo i ->
-          return (keyword "BackTo" ++ pr_intarg i)
-
-      (* State management *)
-        | VernacWriteState s ->
-          return (keyword "Write State" ++ spc () ++ qs s)
-        | VernacRestoreState s ->
-          return  (keyword "Restore State" ++ spc() ++ qs s)
-
-      (* Control *)
-        | VernacLoad (f,s) ->
-          return (
-            keyword "Load"
-            ++ if f then
-                (spc() ++ keyword "Verbose" ++ spc())
-              else
-                spc() ++ qs s
-          )
-        | VernacTime (_,v) ->
-          return (keyword "Time" ++ spc() ++ pr_vernac v)
-        | VernacRedirect (s, (_,v)) ->
-          return (keyword "Redirect" ++ spc() ++ qs s ++ spc() ++ pr_vernac v)
-        | VernacTimeout(n,v) ->
-          return (keyword "Timeout " ++ int n ++ spc() ++ pr_vernac v)
-        | VernacFail v ->
-          return (keyword "Fail" ++ spc() ++ pr_vernac v)
-        | VernacError _ ->
-          return (keyword "No-parsing-rule for VernacError")
-
-      (* Syntax *)
-        | VernacOpenCloseScope (_,(opening,sc)) ->
-          return (
-            keyword (if opening then "Open " else "Close ") ++
-              keyword "Scope" ++ spc() ++ str sc
-          )
-        | VernacDelimiters (sc,Some key) ->
-          return (
-            keyword "Delimit Scope" ++ spc () ++ str sc ++
-              spc() ++ keyword "with" ++ spc () ++ str key
-          )
-        | VernacDelimiters (sc, None) ->
-          return (
-            keyword "Undelimit Scope" ++ spc () ++ str sc
-          )
-        | VernacBindScope (sc,cll) ->
-          return (
-            keyword "Bind Scope" ++ spc () ++ str sc ++
-              spc() ++ keyword "with" ++ spc () ++ prlist_with_sep spc pr_class_rawexpr cll
-          )
-        | VernacArgumentsScope (q,scl) ->
-          let pr_opt_scope = function
-            | None -> str"_"
-            | Some sc -> str sc
-          in
-          return (
-            keyword "Arguments Scope"
-            ++ spc() ++ pr_smart_global q
-            ++ spc() ++ str"[" ++ prlist_with_sep sep pr_opt_scope scl ++ str"]"
-          )
-        | VernacInfix (_,((_,s),mv),q,sn) -> (* A Verifier *)
-          return (
-            hov 0 (hov 0 (keyword "Infix "
-                          ++ qs s ++ str " :=" ++ pr_constrarg q) ++
-                     pr_syntax_modifiers mv ++
-                     (match sn with
-                       | None -> mt()
-                       | Some sc -> spc() ++ str":" ++ spc() ++ str sc))
-          )
-        | VernacNotation (_,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 qs s else str s'
-            else qs s
-          in
-          return (
-            hov 2 (keyword "Notation" ++ spc() ++ ps ++
-                     str " :=" ++ pr_constrarg c ++ pr_syntax_modifiers l ++
-                     (match opt with
-                       | None -> mt()
-                       | Some sc -> str" :" ++ spc() ++ str sc))
-          )
-        | VernacSyntaxExtension (_,(s,l)) ->
-          return (
-            keyword "Reserved Notation" ++ spc() ++ pr_located qs s ++
-              pr_syntax_modifiers l
-          )
-        | VernacNotationAddFormat(s,k,v) ->
-          return (
-            keyword "Format Notation " ++ qs s ++ spc () ++ qs k ++ spc() ++ qs v
-          )
-
-        (* Gallina *)
-        | VernacDefinition (d,id,b) -> (* A verifier... *)
-          let pr_def_token (l,dk) =
-            let l = match l with Some x -> x | None -> Decl_kinds.Global in
-            keyword (Kindops.string_of_definition_kind (l,false,dk))
-          in
-          let pr_reduce = function
-            | None -> mt()
-            | Some r ->
-              keyword "Eval" ++ spc() ++
-                pr_red_expr (pr_constr, pr_lconstr, pr_smart_global, pr_constr) r ++
-                keyword " in" ++ spc()
-          in
-          let pr_def_body = function
-            | DefineBody (bl,red,body,d) ->
-              let ty = match d with
-                | None -> mt()
-                | Some ty -> spc() ++ str":" ++ pr_spc_lconstr ty
+      (* Modules and Module Types *)
+      | VernacDefineModule (export,m,bl,tys,bd) ->
+        let b = pr_module_binders bl pr_lconstr in
+        return (
+          hov 2 (keyword "Module" ++ spc() ++ pr_require_token export ++
+                   pr_lident m ++ b ++
+                   pr_of_module_type pr_lconstr tys ++
+                   (if List.is_empty bd then mt () else str ":= ") ++
+                   prlist_with_sep (fun () -> str " <+")
+                   (pr_module_ast_inl true pr_lconstr) bd)
+        )
+      | VernacDeclareModule (export,id,bl,m1) ->
+        let b = pr_module_binders bl pr_lconstr in
+        return (
+          hov 2 (keyword "Declare Module" ++ spc() ++ pr_require_token export ++
+                   pr_lident id ++ b ++ str " :" ++
+                   pr_module_ast_inl true pr_lconstr m1)
+        )
+      | VernacDeclareModuleType (id,bl,tyl,m) ->
+        let b = pr_module_binders bl pr_lconstr in
+        let pr_mt = pr_module_ast_inl true pr_lconstr in
+        return (
+          hov 2 (keyword "Module Type " ++ pr_lident id ++ b ++
+                   prlist_strict (fun m -> str " <:" ++ pr_mt m) tyl ++
+                   (if List.is_empty m then mt () else str ":= ") ++
+                   prlist_with_sep (fun () -> str " <+ ") pr_mt m)
+        )
+      | VernacInclude (mexprs) ->
+        let pr_m = pr_module_ast_inl false pr_lconstr in
+        return (
+          hov 2 (keyword "Include" ++ spc() ++
+                   prlist_with_sep (fun () -> str " <+ ") pr_m mexprs)
+        )
+      (* Solving *)
+      | VernacSolveExistential (i,c) ->
+        return (keyword "Existential" ++ spc () ++ int i ++ pr_lconstrarg c)
+
+      (* Auxiliary file and library management *)
+      | VernacAddLoadPath (fl,s,d) ->
+        return (
+          hov 2
+            (keyword "Add" ++
+               (if fl then spc () ++ keyword "Rec" ++ spc () else spc()) ++
+               keyword "LoadPath" ++ spc() ++ qs s ++
+               (match d with
+                 | None -> mt()
+                 | Some dir -> spc() ++ keyword "as" ++ spc() ++ pr_dirpath dir))
+        )
+      | VernacRemoveLoadPath s ->
+        return (keyword "Remove LoadPath" ++ qs s)
+      | VernacAddMLPath (fl,s) ->
+        return (
+          keyword "Add"
+          ++ (if fl then spc () ++ keyword "Rec" ++ spc () else spc())
+          ++ keyword "ML Path"
+          ++ qs s
+        )
+      | VernacDeclareMLModule (l) ->
+        return (
+          hov 2 (keyword "Declare ML Module" ++ spc() ++ prlist_with_sep sep qs l)
+        )
+      | VernacChdir s ->
+        return (keyword "Cd" ++ pr_opt qs s)
+
+      (* Commands *)
+      | VernacCreateHintDb (dbname,b) ->
+        return (
+          hov 1 (keyword "Create HintDb" ++ spc () ++
+                   str dbname ++ (if b then str" discriminated" else mt ()))
+        )
+      | VernacRemoveHints (dbnames, ids) ->
+        return (
+          hov 1 (keyword "Remove Hints" ++ spc () ++
+                   prlist_with_sep spc (fun r -> pr_id (coerce_reference_to_id r)) ids ++
+                   pr_opt_hintbases dbnames)
+        )
+      | VernacHints (_, dbnames,h) ->
+        return (pr_hints dbnames h pr_constr pr_constr_pattern_expr)
+      | VernacSyntacticDefinition (id,(ids,c),_,compat) ->
+        return (
+          hov 2
+            (keyword "Notation" ++ spc () ++ pr_lident id ++ spc () ++
+               prlist_with_sep spc pr_id ids ++ str":=" ++ pr_constrarg c ++
+               pr_syntax_modifiers
+               (match compat with
+                | None -> []
+                | Some Flags.Current -> [SetOnlyParsing]
+                | Some v -> [SetCompatVersion v]))
+        )
+      | VernacDeclareImplicits (q,[]) ->
+        return (
+          hov 2 (keyword "Implicit Arguments" ++ spc() ++ pr_smart_global q)
+        )
+      | VernacDeclareImplicits (q,impls) ->
+        return (
+          hov 1 (keyword "Implicit Arguments" ++ spc () ++
+                   spc() ++ pr_smart_global q ++ spc() ++
+                   prlist_with_sep spc (fun imps ->
+                     str"[" ++ prlist_with_sep sep pr_explanation imps ++ str"]")
+                   impls)
+        )
+      | VernacArguments (q, args, more_implicits, nargs, mods) ->
+        return (
+          hov 2 (
+            keyword "Arguments" ++ spc() ++
+              pr_smart_global q ++
+              let pr_s = function None -> str"" | Some (_,s) -> str "%" ++ str s in
+              let pr_if b x = if b then x else str "" in
+              let pr_br imp x = match imp with
+                | Vernacexpr.Implicit -> str "[" ++ x ++ str "]"
+                | Vernacexpr.MaximallyImplicit -> str "{" ++ x ++ str "}"
+                | Vernacexpr.NotImplicit -> x in
+              let rec print_arguments n l =
+                match n, l with
+                  | Some 0, l -> spc () ++ str"/" ++ print_arguments None l
+                  | _, [] -> mt()
+                  | n, { name = id; recarg_like = k;
+                         notation_scope = s;
+                         implicit_status = imp } :: tl ->
+                    spc() ++ pr_br imp (pr_if k (str"!") ++ pr_name id ++ pr_s s) ++
+                      print_arguments (Option.map pred n) tl
+              in
+              let rec print_implicits = function
+                | [] -> mt ()
+                | (name, impl) :: rest ->
+                   spc() ++ pr_br impl (pr_name name) ++ print_implicits rest
               in
-              (pr_binders_arg bl,ty,Some (pr_reduce red ++ pr_lconstr body))
-            | ProveBody (bl,t) ->
-              (pr_binders_arg bl, str" :" ++ pr_spc_lconstr t, None) in
-          let (binds,typ,c) = pr_def_body b in
-          return (
-            hov 2 (
-              pr_def_token d ++ spc()
-              ++ pr_plident id ++ binds ++ typ
-              ++ (match c with
-                | None -> mt()
-                | Some cc -> str" :=" ++ spc() ++ cc))
-          )
-
-        | VernacStartTheoremProof (ki,l,_) ->
-          return (
-            hov 1 (pr_statement (pr_thm_token ki) (List.hd l) ++
-                     prlist (pr_statement (spc () ++ keyword "with")) (List.tl l))
-          )
-
-        | VernacEndProof Admitted ->
-          return (keyword "Admitted")
-
-        | VernacEndProof (Proved (opac,o)) -> return (
-          match o with
-            | None -> (match opac with
-                | Transparent -> keyword "Defined"
-                | Opaque None -> keyword "Qed"
-                | Opaque (Some l) ->
-                    keyword "Qed" ++ spc() ++ str"export" ++
-                      prlist_with_sep (fun () -> str", ") pr_lident l)
-            | Some (id,th) -> (match th with
-                | None -> (if opac <> Transparent then keyword "Save" else keyword "Defined") ++ spc() ++ pr_lident id
-                | Some tok -> keyword "Save" ++ spc() ++ pr_thm_token tok ++ spc() ++ pr_lident id)
+              print_arguments nargs args ++
+                if not (List.is_empty more_implicits) then
+                  prlist (fun l -> str"," ++ print_implicits l) more_implicits
+                else (mt ()) ++
+                (if not (List.is_empty mods) then str" : " else str"") ++
+                  prlist_with_sep (fun () -> str", " ++ spc()) (function
+                    | `ReductionDontExposeCase -> keyword "simpl nomatch"
+                    | `ReductionNeverUnfold -> keyword "simpl never"
+                    | `DefaultImplicits -> keyword "default implicits"
+                    | `Rename -> keyword "rename"
+                    | `Assert -> keyword "assert"
+                    | `ExtraScopes -> keyword "extra scopes"
+                    | `ClearImplicits -> keyword "clear implicits"
+                    | `ClearScopes -> keyword "clear scopes")
+                  mods)
+        )
+      | VernacReserve bl ->
+        let n = List.length (List.flatten (List.map fst bl)) in
+        return (
+          hov 2 (tag_keyword (str"Implicit Type" ++ str (if n > 1 then "s " else " "))
+                 ++ pr_ne_params_list pr_lconstr_expr (List.map (fun sb -> false,sb) bl))
+        )
+      | VernacGeneralizable g ->
+        return (
+          hov 1 (tag_keyword (
+            str"Generalizable Variable" ++
+              match g with
+                | None -> str "s none"
+                | Some [] -> str "s all"
+                | Some idl ->
+                  str (if List.length idl > 1 then "s " else " ") ++
+                    prlist_with_sep spc pr_lident idl)
+          ))
+      | VernacSetOpacity(k,l) when Conv_oracle.is_transparent k ->
+        return (
+          hov 1 (keyword "Transparent" ++
+                   spc() ++ prlist_with_sep sep pr_smart_global l)
+        )
+      | VernacSetOpacity(Conv_oracle.Opaque,l) ->
+        return (
+          hov 1 (keyword "Opaque" ++
+                   spc() ++ prlist_with_sep sep pr_smart_global l)
+        )
+      | VernacSetOpacity _ ->
+        return (
+          CErrors.anomaly (keyword "VernacSetOpacity used to set something else")
+        )
+      | VernacSetStrategy l ->
+        let pr_lev = function
+          | Conv_oracle.Opaque -> keyword "opaque"
+          | Conv_oracle.Expand -> keyword "expand"
+          | l when Conv_oracle.is_transparent l -> keyword "transparent"
+          | Conv_oracle.Level n -> int n
+        in
+        let pr_line (l,q) =
+          hov 2 (pr_lev l ++ spc() ++
+                   str"[" ++ prlist_with_sep sep pr_smart_global q ++ str"]")
+        in
+        return (
+          hov 1 (keyword "Strategy" ++ spc() ++
+                   hv 0 (prlist_with_sep sep pr_line l))
+        )
+      | VernacUnsetOption (na) ->
+        return (
+          hov 1 (keyword "Unset" ++ spc() ++ pr_printoption na None)
+        )
+      | VernacSetOption (na,v) ->
+        return (
+          hov 2 (keyword "Set" ++ spc() ++ pr_set_option na v)
+        )
+      | VernacSetAppendOption (na,v) ->
+        return (
+          hov 2 (keyword "Set" ++ spc() ++ pr_printoption na None ++
+                   spc() ++ keyword "Append" ++ spc() ++ qs v)
+        )
+      | VernacAddOption (na,l) ->
+        return (
+          hov 2 (keyword "Add" ++ spc() ++ pr_printoption na (Some l))
+        )
+      | VernacRemoveOption (na,l) ->
+        return (
+          hov 2 (keyword "Remove" ++ spc() ++ pr_printoption na (Some l))
+        )
+      | VernacMemOption (na,l) ->
+        return (
+          hov 2 (keyword "Test" ++ spc() ++ pr_printoption na (Some l))
+        )
+      | VernacPrintOption na ->
+        return (
+          hov 2 (keyword "Test" ++ spc() ++ pr_printoption na None)
+        )
+      | VernacCheckMayEval (r,io,c) ->
+        let pr_mayeval r c = match r with
+          | Some r0 ->
+            hov 2 (keyword "Eval" ++ spc() ++
+                     pr_red_expr (pr_constr,pr_lconstr,pr_smart_global, pr_constr) keyword r0 ++
+                     spc() ++ keyword "in" ++ spc () ++ pr_lconstr c)
+          | None -> hov 2 (keyword "Check" ++ spc() ++ pr_lconstr c)
+        in
+        let pr_i = match io with None -> mt () | Some i -> int i ++ str ": " in
+        return (pr_i ++ pr_mayeval r c)
+      | VernacGlobalCheck c ->
+        return (hov 2 (keyword "Type" ++ pr_constrarg c))
+      | VernacDeclareReduction (s,r) ->
+        return (
+          keyword "Declare Reduction" ++ spc () ++ str s ++ str " := " ++
+            pr_red_expr (pr_constr,pr_lconstr,pr_smart_global, pr_constr) keyword r
+        )
+      | VernacPrint p ->
+        return (pr_printable p)
+      | VernacSearch (sea,g,sea_r) ->
+        return (pr_search sea g sea_r pr_constr_pattern_expr)
+      | VernacLocate loc ->
+        let pr_locate =function
+          | LocateAny qid -> pr_smart_global qid
+          | LocateTerm qid -> keyword "Term" ++ spc() ++ pr_smart_global qid
+          | LocateFile f -> keyword "File" ++ spc() ++ qs f
+          | LocateLibrary qid -> keyword "Library" ++ spc () ++ pr_module qid
+          | LocateModule qid -> keyword "Module" ++ spc () ++ pr_module qid
+          | LocateTactic qid -> keyword "Ltac" ++ spc () ++ pr_ltac_ref qid
+        in
+        return (keyword "Locate" ++ spc() ++ pr_locate loc)
+      | VernacRegister (id, RegisterInline) ->
+        return (
+          hov 2
+            (keyword "Register Inline" ++ spc() ++ pr_lident id)
+        )
+      | VernacComments l ->
+        return (
+          hov 2
+            (keyword "Comments" ++ spc()
+             ++ prlist_with_sep sep (pr_comment pr_constr) l)
+        )
+
+      (* Toplevel control *)
+      | VernacToplevelControl exn ->
+        return (pr_topcmd exn)
+
+      (* For extension *)
+      | VernacExtend (s,c) ->
+        return (pr_extend s c)
+      | VernacProof (None, None) ->
+        return (keyword "Proof")
+      | VernacProof (None, Some e) ->
+        return (keyword "Proof " ++ spc () ++
+            keyword "using" ++ spc() ++ pr_using e)
+      | VernacProof (Some te, None) ->
+        return (keyword "Proof with" ++ spc() ++ Pputils.pr_raw_generic (Global.env ()) te)
+      | VernacProof (Some te, Some e) ->
+        return (
+          keyword "Proof" ++ spc () ++
+            keyword "using" ++ spc() ++ pr_using e ++ spc() ++
+            keyword "with" ++ spc() ++ Pputils.pr_raw_generic (Global.env ()) te
         )
-        | VernacExactProof c ->
-          return (hov 2 (keyword "Proof" ++ pr_lconstrarg c))
-        | VernacAssumption (stre,_,l) ->
-          let n = List.length (List.flatten (List.map fst (List.map snd l))) in
-          let pr_params (c, (xl, t)) =
-            hov 2 (prlist_with_sep sep pr_plident xl ++ spc() ++
-              (if c then str":>" else str":" ++ spc() ++ pr_lconstr_expr t))
-          in
-          let assumptions = prlist_with_sep spc (fun p -> hov 1 (str "(" ++ pr_params p ++ str ")")) l in
-          return (hov 2 (pr_assumption_token (n > 1) stre ++ spc() ++ assumptions))
-        | VernacInductive (p,f,l) ->
-          let pr_constructor (coe,(id,c)) =
-            hov 2 (pr_lident id ++ str" " ++
-                     (if coe then str":>" else str":") ++
-                     pr_spc_lconstr c)
-          in
-          let pr_constructor_list b l = match l with
-            | Constructors [] -> mt()
-            | Constructors l ->
-              let fst_sep = match l with [_] -> "   " | _ -> " | " in
-              pr_com_at (begin_of_inductive l) ++
-                fnl() ++ str fst_sep ++
-                prlist_with_sep (fun _ -> fnl() ++ str" | ") pr_constructor l
-            | RecordDecl (c,fs) ->
-              pr_record_decl b c fs
-          in
-          let pr_oneind key (((coe,(id,pl)),indpar,s,k,lc),ntn) =
-            hov 0 (
-              str key ++ spc() ++
-                (if coe then str"> " else str"") ++ pr_lident id ++ pr_univs pl ++
-                pr_and_type_binders_arg indpar ++
-                pr_opt (fun s -> str":" ++ spc() ++ pr_lconstr_expr s) s ++
-                str" :=") ++ pr_constructor_list k lc ++
-              prlist (pr_decl_notation pr_constr) ntn
-          in
-          let key =
-            let (_,_,_,k,_),_ = List.hd l in
-            match k with Record -> "Record" | Structure -> "Structure"
-              | Inductive_kw -> "Inductive" | CoInductive -> "CoInductive"
-              | Class _ -> "Class" | Variant -> "Variant"
-          in
-          return (
-            hov 1 (pr_oneind key (List.hd l)) ++
-              (prlist (fun ind -> fnl() ++ hov 1 (pr_oneind "with" ind)) (List.tl l))
-          )
-
-        | VernacFixpoint (local, recs) ->
-          let local = match local with
-            | Some Discharge -> "Let "
-            | Some Local -> "Local "
-            | None | Some Global -> ""
-          in
-          let pr_onerec = function
-            | (((loc,id),pl),ro,bl,type_,def),ntn ->
-              let annot = pr_guard_annot pr_lconstr_expr bl ro in
-              pr_id id ++ pr_univs pl ++ pr_binders_arg bl ++ annot
-              ++ pr_type_option (fun c -> spc() ++ pr_lconstr_expr c) type_
-              ++ pr_opt (fun def -> str":=" ++ brk(1,2) ++ pr_lconstr def) def ++
-                prlist (pr_decl_notation pr_constr) ntn
-          in
-          return (
-            hov 0 (str local ++ keyword "Fixpoint" ++ spc () ++
-                     prlist_with_sep (fun _ -> fnl () ++ keyword "with" ++ spc ()) pr_onerec recs)
-          )
-
-        | VernacCoFixpoint (local, corecs) ->
-          let local = match local with
-            | Some Discharge -> keyword "Let" ++ spc ()
-            | Some Local -> keyword "Local" ++ spc ()
-            | None | Some Global -> str ""
-          in
-          let pr_onecorec ((((loc,id),pl),bl,c,def),ntn) =
-            pr_id id ++ pr_univs pl ++ spc() ++ pr_binders bl ++ spc() ++ str":" ++
-              spc() ++ pr_lconstr_expr c ++
-              pr_opt (fun def -> str":=" ++ brk(1,2) ++ pr_lconstr def) def ++
-              prlist (pr_decl_notation pr_constr) ntn
-          in
-          return (
-            hov 0 (local ++ keyword "CoFixpoint" ++ spc() ++
-                     prlist_with_sep (fun _ -> fnl() ++ keyword "with" ++ spc ()) pr_onecorec corecs)
-          )
-        | VernacScheme l ->
-          return (
-            hov 2 (keyword "Scheme" ++ spc() ++
-                     prlist_with_sep (fun _ -> fnl() ++ keyword "with" ++ spc ()) pr_onescheme l)
-          )
-        | VernacCombinedScheme (id, l) ->
-          return (
-            hov 2 (keyword "Combined Scheme" ++ spc() ++
-                     pr_lident id ++ spc() ++ keyword "from" ++ spc() ++
-                     prlist_with_sep (fun _ -> fnl() ++ str", ") pr_lident l)
-          )
-        | VernacUniverse v ->
-          return (
-            hov 2 (keyword "Universe" ++ spc () ++
-                     prlist_with_sep (fun _ -> str",") pr_lident v)
-          )
-        | VernacConstraint v ->
-          let pr_uconstraint (l, d, r) =
-            pr_lident l ++ spc () ++ Univ.pr_constraint_type d ++ spc () ++ pr_lident r
-          in
-          return (
-            hov 2 (keyword "Constraint" ++ spc () ++
-                     prlist_with_sep (fun _ -> str",") pr_uconstraint v)
-          )
-
-        (* Gallina extensions *)
-        | VernacBeginSection id ->
-          return (hov 2 (keyword "Section" ++ spc () ++ pr_lident id))
-        | VernacEndSegment id ->
-          return (hov 2 (keyword "End" ++ spc() ++ pr_lident id))
-        | VernacNameSectionHypSet (id,set) ->
-          return (hov 2 (keyword "Package" ++ spc() ++ pr_lident id ++ spc()++
-          str ":="++spc()++pr_using set))
-        | VernacRequire (from, exp, l) ->
-          let from = match from with
-          | None -> mt ()
-          | Some r -> keyword "From" ++ spc () ++ pr_module r ++ spc ()
-          in
-          return (
-            hov 2
-              (from ++ keyword "Require" ++ spc() ++ pr_require_token exp ++
-                 prlist_with_sep sep pr_module l)
-          )
-        | VernacImport (f,l) ->
-          return (
-            (if f then keyword "Export" else keyword "Import") ++ spc() ++
-              prlist_with_sep sep pr_import_module l
-          )
-        | VernacCanonical q ->
-          return (
-            keyword "Canonical Structure" ++ spc() ++ pr_smart_global q
-          )
-        | VernacCoercion (_,id,c1,c2) ->
-          return (
-            hov 1 (
-              keyword "Coercion" ++ spc() ++
-                pr_smart_global id ++ spc() ++ str":" ++ spc() ++ pr_class_rawexpr c1 ++
-                spc() ++ str">->" ++ spc() ++ pr_class_rawexpr c2)
-          )
-        | VernacIdentityCoercion (_,id,c1,c2) ->
-          return (
-            hov 1 (
-              keyword "Identity Coercion" ++ spc() ++ pr_lident id ++
-                spc() ++ str":" ++ spc() ++ pr_class_rawexpr c1 ++ spc() ++ str">->" ++
-                spc() ++ pr_class_rawexpr c2)
-          )
-
-        | VernacInstance (abst, sup, (instid, bk, cl), props, pri) ->
-          return (
-            hov 1 (
-              (if abst then keyword "Declare" ++ spc () else mt ()) ++
-                keyword "Instance" ++
-                (match instid with
-		 | (loc, Name id), l -> spc () ++ pr_plident ((loc, id),l) ++ spc () 
-                 | (_, Anonymous), _ -> mt ()) ++
-                pr_and_type_binders_arg sup ++
-                str":" ++ spc () ++
-                pr_constr cl ++ pr_priority pri ++
-                (match props with
-                  | Some (_,p) -> spc () ++ str":=" ++ spc () ++ pr_constr p
-                  | None -> mt()))
-          )
-
-        | VernacContext l ->
-          return (
-            hov 1 (
-              keyword "Context" ++ spc () ++ pr_and_type_binders_arg l)
-          )
-
-        | VernacDeclareInstances (ids, pri) ->
-          return (
-            hov 1 (keyword "Existing" ++ spc () ++
-                     keyword(String.plural (List.length ids) "Instance") ++
-                     spc () ++ prlist_with_sep spc pr_reference ids ++ pr_priority pri)
-          )
-
-        | VernacDeclareClass id ->
-          return (
-            hov 1 (keyword "Existing" ++ spc () ++ keyword "Class" ++ spc () ++ pr_reference id)
-          )
-
-        (* Modules and Module Types *)
-        | VernacDefineModule (export,m,bl,tys,bd) ->
-          let b = pr_module_binders bl pr_lconstr in
-          return (
-            hov 2 (keyword "Module" ++ spc() ++ pr_require_token export ++
-                     pr_lident m ++ b ++
-                     pr_of_module_type pr_lconstr tys ++
-                     (if List.is_empty bd then mt () else str ":= ") ++
-                     prlist_with_sep (fun () -> str " <+ ")
-                     (pr_module_ast_inl true pr_lconstr) bd)
-          )
-        | VernacDeclareModule (export,id,bl,m1) ->
-          let b = pr_module_binders bl pr_lconstr in
-          return (
-            hov 2 (keyword "Declare Module" ++ spc() ++ pr_require_token export ++
-                     pr_lident id ++ b ++
-                     pr_module_ast_inl true pr_lconstr m1)
-          )
-        | VernacDeclareModuleType (id,bl,tyl,m) ->
-          let b = pr_module_binders bl pr_lconstr in
-          let pr_mt = pr_module_ast_inl true pr_lconstr in
-          return (
-            hov 2 (keyword "Module Type " ++ pr_lident id ++ b ++
-                     prlist_strict (fun m -> str " <: " ++ pr_mt m) tyl ++
-                     (if List.is_empty m then mt () else str ":= ") ++
-                     prlist_with_sep (fun () -> str " <+ ") pr_mt m)
-          )
-        | VernacInclude (mexprs) ->
-          let pr_m = pr_module_ast_inl false pr_lconstr in
-          return (
-            hov 2 (keyword "Include" ++ spc() ++
-                     prlist_with_sep (fun () -> str " <+ ") pr_m mexprs)
-          )
-        (* Solving *)
-        | VernacSolveExistential (i,c) ->
-          return (keyword "Existential" ++ spc () ++ int i ++ pr_lconstrarg c)
-
-        (* Auxiliary file and library management *)
-        | VernacAddLoadPath (fl,s,d) ->
-          return (
-            hov 2
-              (keyword "Add" ++
-                 (if fl then spc () ++ keyword "Rec" ++ spc () else spc()) ++
-                 keyword "LoadPath" ++ spc() ++ qs s ++
-                 (match d with
-                   | None -> mt()
-                   | Some dir -> spc() ++ keyword "as" ++ spc() ++ pr_dirpath dir))
-          )
-        | VernacRemoveLoadPath s ->
-          return (keyword "Remove LoadPath" ++ qs s)
-        | VernacAddMLPath (fl,s) ->
-          return (
-            keyword "Add"
-            ++ (if fl then spc () ++ keyword "Rec" ++ spc () else spc())
-            ++ keyword "ML Path"
-            ++ qs s
-          )
-        | VernacDeclareMLModule (l) ->
-          return (
-            hov 2 (keyword "Declare ML Module" ++ spc() ++ prlist_with_sep sep qs l)
-          )
-        | VernacChdir s ->
-          return (keyword "Cd" ++ pr_opt qs s)
-
-        (* Commands *)
-        | VernacCreateHintDb (dbname,b) ->
-          return (
-            hov 1 (keyword "Create HintDb" ++ spc () ++
-                     str dbname ++ (if b then str" discriminated" else mt ()))
-          )
-        | VernacRemoveHints (dbnames, ids) ->
-          return (
-            hov 1 (keyword "Remove Hints" ++ spc () ++
-                     prlist_with_sep spc (fun r -> pr_id (coerce_reference_to_id r)) ids ++
-                     pr_opt_hintbases dbnames)
-          )
-        | VernacHints (_, dbnames,h) ->
-          return (pr_hints dbnames h pr_constr pr_constr_pattern_expr)
-        | VernacSyntacticDefinition (id,(ids,c),_,onlyparsing) ->
-          return (
-            hov 2
-              (keyword "Notation" ++ spc () ++ pr_lident id ++ spc () ++
-                 prlist (fun x -> spc() ++ pr_id x) ids ++ str":=" ++ pr_constrarg c ++
-                 pr_syntax_modifiers
-                 (match onlyparsing with None -> [] | Some v -> [SetOnlyParsing v]))
-          )
-        | VernacDeclareImplicits (q,[]) ->
-          return (
-            hov 2 (keyword "Implicit Arguments" ++ spc() ++ pr_smart_global q)
-          )
-        | VernacDeclareImplicits (q,impls) ->
-          return (
-            hov 1 (keyword "Implicit Arguments" ++ spc () ++
-                     spc() ++ pr_smart_global q ++ spc() ++
-                     prlist_with_sep spc (fun imps ->
-                       str"[" ++ prlist_with_sep sep pr_explanation imps ++ str"]")
-                     impls)
-          )
-        | VernacArguments (q, impl, nargs, mods) ->
-          return (
-            hov 2 (
-              keyword "Arguments" ++ spc() ++
-                pr_smart_global q ++
-                let pr_s = function None -> str"" | Some (_,s) -> str "%" ++ str s in
-                let pr_if b x = if b then x else str "" in
-                let pr_br imp max x = match imp, max with
-                  | true, false -> str "[" ++ x ++ str "]"
-                  | true, true -> str "{" ++ x ++ str "}"
-                  | _ -> x in
-                let rec aux n l =
-                  match n, l with
-                    | 0, l -> spc () ++ str"/" ++ aux ~-1 l
-                    | _, [] -> mt()
-                    | n, (id,k,s,imp,max) :: tl ->
-                      spc() ++ pr_br imp max (pr_if k (str"!") ++ pr_name id ++ pr_s s) ++
-                        aux (n-1) tl in
-                prlist_with_sep (fun () -> str", ") (aux nargs) impl ++
-                  if not (List.is_empty mods) then str" : " else str"" ++
-                    prlist_with_sep (fun () -> str", " ++ spc()) (function
-                      | `ReductionDontExposeCase -> keyword "simpl nomatch"
-                      | `ReductionNeverUnfold -> keyword "simpl never"
-                      | `DefaultImplicits -> keyword "default implicits"
-                      | `Rename -> keyword "rename"
-                      | `Assert -> keyword "assert"
-                      | `ExtraScopes -> keyword "extra scopes"
-                      | `ClearImplicits -> keyword "clear implicits"
-                      | `ClearScopes -> keyword "clear scopes")
-                    mods)
-          )
-        | VernacReserve bl ->
-          let n = List.length (List.flatten (List.map fst bl)) in
-          return (
-            hov 2 (tag_keyword (str"Implicit Type" ++ str (if n > 1 then "s " else " "))
-                   ++ pr_ne_params_list pr_lconstr_expr (List.map (fun sb -> false,sb) bl))
-          )
-        | VernacGeneralizable g ->
-          return (
-            hov 1 (tag_keyword (
-              str"Generalizable Variable" ++
-                match g with
-                  | None -> str "s none"
-                  | Some [] -> str "s all"
-                  | Some idl ->
-                    str (if List.length idl > 1 then "s " else " ") ++
-                      prlist_with_sep spc pr_lident idl)
-            ))
-        | VernacSetOpacity(k,l) when Conv_oracle.is_transparent k ->
-          return (
-            hov 1 (keyword "Transparent" ++
-                     spc() ++ prlist_with_sep sep pr_smart_global l)
-          )
-        | VernacSetOpacity(Conv_oracle.Opaque,l) ->
-          return (
-            hov 1 (keyword "Opaque" ++
-                     spc() ++ prlist_with_sep sep pr_smart_global l)
-          )
-        | VernacSetOpacity _ ->
-          return (
-            Errors.anomaly (keyword "VernacSetOpacity used to set something else")
-          )
-        | VernacSetStrategy l ->
-          let pr_lev = function
-            | Conv_oracle.Opaque -> keyword "opaque"
-            | Conv_oracle.Expand -> keyword "expand"
-            | l when Conv_oracle.is_transparent l -> keyword "transparent"
-            | Conv_oracle.Level n -> int n
-          in
-          let pr_line (l,q) =
-            hov 2 (pr_lev l ++ spc() ++
-                     str"[" ++ prlist_with_sep sep pr_smart_global q ++ str"]")
-          in
-          return (
-            hov 1 (keyword "Strategy" ++ spc() ++
-                     hv 0 (prlist_with_sep sep pr_line l))
-          )
-        | VernacUnsetOption (na) ->
-          return (
-            hov 1 (keyword "Unset" ++ spc() ++ pr_printoption na None)
-          )
-        | VernacSetOption (na,v) ->
-          return (
-            hov 2 (keyword "Set" ++ spc() ++ pr_set_option na v)
-          )
-        | VernacAddOption (na,l) ->
-          return (
-            hov 2 (keyword "Add" ++ spc() ++ pr_printoption na (Some l))
-          )
-        | VernacRemoveOption (na,l) ->
-          return (
-            hov 2 (keyword "Remove" ++ spc() ++ pr_printoption na (Some l))
-          )
-        | VernacMemOption (na,l) ->
-          return (
-            hov 2 (keyword "Test" ++ spc() ++ pr_printoption na (Some l))
-          )
-        | VernacPrintOption na ->
-          return (
-            hov 2 (keyword "Test" ++ spc() ++ pr_printoption na None)
-          )
-        | VernacCheckMayEval (r,io,c) ->
-          let pr_mayeval r c = match r with
-            | Some r0 ->
-              hov 2 (keyword "Eval" ++ spc() ++
-                       pr_red_expr (pr_constr,pr_lconstr,pr_smart_global, pr_constr) r0 ++
-                       spc() ++ keyword "in" ++ spc () ++ pr_lconstr c)
-            | None -> hov 2 (keyword "Check" ++ spc() ++ pr_lconstr c)
-          in
-          let pr_i = match io with None -> mt () | Some i -> int i ++ str ": " in
-          return (pr_i ++ pr_mayeval r c)
-        | VernacGlobalCheck c ->
-          return (hov 2 (keyword "Type" ++ pr_constrarg c))
-        | VernacDeclareReduction (s,r) ->
-          return (
-            keyword "Declare Reduction" ++ spc () ++ str s ++ str " := " ++
-              pr_red_expr (pr_constr,pr_lconstr,pr_smart_global, pr_constr) r
-          )
-        | VernacPrint p ->
-          return (pr_printable p)
-        | VernacSearch (sea,g,sea_r) ->
-          return (pr_search sea g sea_r pr_constr_pattern_expr)
-        | VernacLocate loc ->
-          let pr_locate =function
-            | LocateAny qid -> pr_smart_global qid
-            | LocateTerm qid -> keyword "Term" ++ spc() ++ pr_smart_global qid
-            | LocateFile f -> keyword "File" ++ spc() ++ qs f
-            | LocateLibrary qid -> keyword "Library" ++ spc () ++ pr_module qid
-            | LocateModule qid -> keyword "Module" ++ spc () ++ pr_module qid
-            | LocateTactic qid -> keyword "Ltac" ++ spc () ++ pr_ltac_ref qid
-          in
-          return (keyword "Locate" ++ spc() ++ pr_locate loc)
-        | VernacRegister (id, RegisterInline) ->
-          return (
-            hov 2
-              (keyword "Register Inline" ++ spc() ++ pr_lident id)
-          )
-        | VernacComments l ->
-          return (
-            hov 2
-              (keyword "Comments" ++ spc()
-               ++ prlist_with_sep sep (pr_comment pr_constr) l)
-          )
-
-        (* Toplevel control *)
-        | VernacToplevelControl exn ->
-          return (pr_topcmd exn)
-
-        (* For extension *)
-        | VernacExtend (s,c) ->
-          return (pr_extend s c)
-        | VernacProof (None, None) ->
-          return (keyword "Proof")
-        | VernacProof (None, Some e) ->
-          return (keyword "Proof " ++ spc () ++
-              keyword "using" ++ spc() ++ pr_using e)
-        | VernacProof (Some te, None) ->
-          return (keyword "Proof with" ++ spc() ++ pr_raw_tactic te)
-        | VernacProof (Some te, Some e) ->
-          return (
-            keyword "Proof" ++ spc () ++
-              keyword "using" ++ spc() ++ pr_using e ++ spc() ++
-              keyword "with" ++ spc() ++pr_raw_tactic te
-          )
-        | VernacProofMode s ->
-          return (keyword "Proof Mode" ++ str s)
-        | VernacBullet b ->
-          return (begin match b with
-            | Dash n -> str (String.make n '-')
-            | Star n -> str (String.make n '*')
-            | Plus n -> str (String.make n '+')
-          end ++ spc())
-        | VernacSubproof None ->
-          return (str "{")
-        | VernacSubproof (Some i) ->
-          return (keyword "BeginSubproof" ++ spc () ++ int i)
-        | VernacEndSubproof ->
-          return (str "}")
-
-    and pr_extend s cl =
-      let pr_arg a =
-        try pr_gen a
-        with Failure _ -> str "<error in " ++ str (fst s) ++ str ">" in
-      try
-        let rl = Egramml.get_extend_vernac_rule s in
-        let rec aux rl cl =
-          match rl, cl with
-          | Egramml.GramNonTerminal _ :: rl, arg :: cl -> pr_arg arg :: aux rl cl
-          | Egramml.GramTerminal s :: rl, cl -> str s :: aux rl cl
-          | [], [] -> []
-          | _ -> assert false in
-        hov 1 (pr_sequence (fun x -> x) (aux rl cl))
-      with Not_found ->
-        hov 1 (str "TODO(" ++ str (fst s) ++ spc () ++ prlist_with_sep sep pr_arg cl ++ str ")")
-
-    in pr_vernac
-
-  let pr_vernac_body v = make_pr_vernac pr_constr_expr pr_lconstr_expr v
-
-  let pr_vernac v = make_pr_vernac pr_constr_expr pr_lconstr_expr v ++ sep_end v
-
-  let pr_vernac x =
-    try pr_vernac x
-    with e -> Errors.print e
+      | VernacProofMode s ->
+        return (keyword "Proof Mode" ++ str s)
+      | VernacBullet b ->
+        return (begin match b with
+          | Dash n -> str (String.make n '-')
+          | Star n -> str (String.make n '*')
+          | Plus n -> str (String.make n '+')
+        end)
+      | VernacSubproof None ->
+        return (str "{")
+      | VernacSubproof (Some i) ->
+        return (keyword "BeginSubproof" ++ spc () ++ int i)
+      | VernacEndSubproof ->
+        return (str "}")
+
+  and pr_extend s cl =
+    let pr_arg a =
+      try pr_gen a
+      with Failure _ -> str "<error in " ++ str (fst s) ++ str ">" in
+    try
+      let rl = Egramml.get_extend_vernac_rule s in
+      let rec aux rl cl =
+        match rl, cl with
+        | Egramml.GramNonTerminal _ :: rl, arg :: cl -> pr_arg arg :: aux rl cl
+        | Egramml.GramTerminal s :: rl, cl -> str s :: aux rl cl
+        | [], [] -> []
+        | _ -> assert false in
+      hov 1 (pr_sequence (fun x -> x) (aux rl cl))
+    with Not_found ->
+      hov 1 (str "TODO(" ++ str (fst s) ++ spc () ++ prlist_with_sep sep pr_arg cl ++ str ")")
+
+  let pr_vernac v =
+    try pr_vernac_body v ++ sep_end v
+    with e -> CErrors.print e
 
 end
 
-include Make (Ppconstr) (Pptactic) (struct
+include Make (Ppconstr) (struct
   let do_not_tag _ x = x
   let tag_keyword = do_not_tag ()
   let tag_vernac  = do_not_tag
@@ -1234,7 +1257,6 @@ module Richpp = struct
 
   include Make
     (Ppconstr.Richpp)
-    (Pptactic.Richpp)
     (struct
       open Ppannotation
       let tag_keyword s = Pp.tag (Pp.Tag.inj AKeyword tag) s
diff --git a/printing/ppvernacsig.mli b/printing/ppvernacsig.mli
index 5d1c89332..5e5e4bcf4 100644
--- a/printing/ppvernacsig.mli
+++ b/printing/ppvernacsig.mli
@@ -8,6 +8,9 @@
 
 module type Pp = sig
 
+  (** Prints a fixpoint body *)
+  val pr_rec_definition : (Vernacexpr.fixpoint_expr * Vernacexpr.decl_notation list) -> Pp.std_ppcmds
+
   (** Prints a vernac expression *)
   val pr_vernac_body : Vernacexpr.vernac_expr -> Pp.std_ppcmds
 
diff --git a/printing/prettyp.ml b/printing/prettyp.ml
index 9745a7925..8fabb7053 100644
--- a/printing/prettyp.ml
+++ b/printing/prettyp.ml
@@ -11,7 +11,7 @@
  *)
 
 open Pp
-open Errors
+open CErrors
 open Util
 open Names
 open Nameops
@@ -27,6 +27,10 @@ open Recordops
 open Misctypes
 open Printer
 open Printmod
+open Context.Rel.Declaration
+
+module RelDecl = Context.Rel.Declaration
+module NamedDecl = Context.Named.Declaration
 
 type object_pr = {
   print_inductive           : mutual_inductive -> std_ppcmds;
@@ -132,7 +136,6 @@ let print_renames_list prefix l =
 let need_expansion impl ref =
   let typ = Global.type_of_global_unsafe ref in
   let ctx = prod_assum typ in
-  let open Context.Rel.Declaration in
   let nprods = List.count is_local_assum ctx in
   not (List.is_empty impl) && List.length impl >= nprods &&
     let _,lastimpl = List.chop nprods impl in
@@ -170,9 +173,8 @@ type opacity =
   | TransparentMaybeOpacified of Conv_oracle.level
 
 let opacity env =
-  let open Context.Named.Declaration in
   function
-  | VarRef v when is_local_def (Environ.lookup_named v env) ->
+  | VarRef v when NamedDecl.is_local_def (Environ.lookup_named v env) ->
       Some(TransparentMaybeOpacified
         (Conv_oracle.get_strategy (Environ.oracle env) (VarKey v)))
   | ConstRef cst ->
@@ -215,15 +217,21 @@ let print_polymorphism ref =
        else "not universe polymorphic") ]
   else []
 
+let print_type_in_type ref =
+  let unsafe = Global.is_type_in_type ref in
+  if unsafe then
+    [ pr_global ref ++ str " relies on an unsafe universe hierarchy"]
+  else []
+
 let print_primitive_record recflag mipv = function
   | Some (Some (_, ps,_)) ->
     let eta = match recflag with
-    | Decl_kinds.CoFinite | Decl_kinds.Finite -> mt ()
-    | Decl_kinds.BiFinite -> str " and has eta conversion"
+    | Decl_kinds.CoFinite | Decl_kinds.Finite -> str" without eta conversion"
+    | Decl_kinds.BiFinite -> str " with eta conversion"
     in
-    [pr_id mipv.(0).mind_typename ++ str" is primitive" ++ eta ++ str"."]
+    [pr_id mipv.(0).mind_typename ++ str" has primitive projections" ++ eta ++ str"."]
   | _ -> []
-    
+
 let print_primitive ref =
   match ref with 
   | IndRef ind -> 
@@ -235,7 +243,7 @@ let print_name_infos ref =
   let impls = implicits_of_global ref in
   let scopes = Notation.find_arguments_scope ref in
   let renames =
-    try List.hd (Arguments_renaming.arguments_names ref) with Not_found -> [] in
+    try Arguments_renaming.arguments_names ref with Not_found -> [] in
   let type_info_for_implicit =
     if need_expansion (select_impargs_size 0 impls) ref then
       (* Need to reduce since implicits are computed with products flattened *)
@@ -244,6 +252,7 @@ let print_name_infos ref =
     else
       [] in
   print_polymorphism ref @
+  print_type_in_type ref @
   print_primitive ref @
   type_info_for_implicit @
   print_renames_list (mt()) renames @
@@ -274,7 +283,7 @@ let print_inductive_implicit_args =
 let print_inductive_renames =
   print_args_data_of_inductive_ids
     (fun r ->
-      try List.hd (Arguments_renaming.arguments_names r) with Not_found -> [])
+      try Arguments_renaming.arguments_names r with Not_found -> [])
     ((!=) Anonymous)
     print_renames_list
 
@@ -693,7 +702,7 @@ let read_sec_context r =
   let dir =
     try Nametab.locate_section qid
     with Not_found ->
-      user_err_loc (loc,"read_sec_context", str "Unknown section.") in
+      user_err ~loc ~hdr:"read_sec_context" (str "Unknown section.") in
   let rec get_cxt in_cxt = function
     | (_,Lib.OpenedSection ((dir',_),_) as hd)::rest ->
         if DirPath.equal dir dir' then (hd::in_cxt) else get_cxt (hd::in_cxt) rest
@@ -726,11 +735,10 @@ let print_any_name = function
   try  (* Var locale de but, pas var de section... donc pas d'implicits *)
     let dir,str = repr_qualid qid in
     if not (DirPath.is_empty dir) then raise Not_found;
-    let open Context.Named.Declaration in
-    str |> Global.lookup_named |> set_id str |> print_named_decl
+    str |> Global.lookup_named |> NamedDecl.set_id str |> print_named_decl
   with Not_found ->
-    errorlabstrm
-      "print_name" (pr_qualid qid ++ spc () ++ str "not a defined object.")
+    user_err
+      ~hdr:"print_name" (pr_qualid qid ++ spc () ++ str "not a defined object.")
 
 let print_name = function
   | ByNotation (loc,ntn,sc) ->
@@ -755,8 +763,7 @@ let print_opaque_name qid =
 	let ty = Universes.unsafe_type_of_global gr in
 	print_typed_value (mkConstruct cstr, ty)
     | VarRef id ->
-        let open Context.Named.Declaration in
-        lookup_named id env |> set_id id |> print_named_decl
+        env |> lookup_named id |> NamedDecl.set_id id |> print_named_decl
 
 let print_about_any loc k =
   match k with
@@ -824,7 +831,7 @@ let index_of_class cl =
   try
     fst (class_info cl)
   with Not_found ->
-    errorlabstrm "index_of_class"
+    user_err ~hdr:"index_of_class"
       (pr_class cl ++ spc() ++ str "not a defined class.")
 
 let print_path_between cls clt =
@@ -834,7 +841,7 @@ let print_path_between cls clt =
     try
       lookup_path_between_class (i,j)
     with Not_found ->
-      errorlabstrm "index_cl_of_id"
+      user_err ~hdr:"index_cl_of_id"
         (str"No path between " ++ pr_class cls ++ str" and " ++ pr_class clt
 	 ++ str ".")
   in
@@ -865,7 +872,7 @@ let pr_instance env i =
   (*   gallina_print_constant_with_infos i.is_impl *)
   (* lighter *)
   print_ref false (instance_impl i) ++
-  begin match instance_priority i with
+  begin match hint_priority i with
   | None -> mt ()
   | Some i -> spc () ++ str "|" ++ spc () ++ int i
   end
diff --git a/printing/printer.ml b/printing/printer.ml
index cc8da4097..bfc2e1bc9 100644
--- a/printing/printer.ml
+++ b/printing/printer.ml
@@ -7,7 +7,7 @@
 (************************************************************************)
 
 open Pp
-open Errors
+open CErrors
 open Util
 open Names
 open Term
@@ -22,6 +22,10 @@ open Constrextern
 open Ppconstr
 open Declarations
 
+module RelDecl = Context.Rel.Declaration
+module NamedDecl = Context.Named.Declaration
+module CompactedDecl = Context.Compacted.Declaration
+
 let emacs_str s =
   if !Flags.print_emacs then s else ""
 let delayed_emacs_cmd s =
@@ -184,7 +188,7 @@ let safe_gen f env sigma c =
   let orig_extern_ref = Constrextern.get_extern_reference () in
   let extern_ref loc vars r =
     try orig_extern_ref loc vars r
-    with e when Errors.noncritical e ->
+    with e when CErrors.noncritical e ->
       Libnames.Qualid (loc, qualid_of_global env r)
   in
   Constrextern.set_extern_reference extern_ref;
@@ -192,7 +196,7 @@ let safe_gen f env sigma c =
     let p = f env sigma c in
     Constrextern.set_extern_reference orig_extern_ref;
     p
-  with e when Errors.noncritical e ->
+  with e when CErrors.noncritical e ->
     Constrextern.set_extern_reference orig_extern_ref;
     str "??"
 
@@ -248,31 +252,30 @@ let pr_pattern t = pr_pattern_env (Global.env()) empty_names_context t*)
 (**********************************************************************)
 (* Contexts and declarations                                          *)
 
-let pr_var_decl_skel pr_id env sigma (id,c,typ) =
-  let pbody = match c with
-    | None ->  (mt ())
-    | Some c ->
-	(* Force evaluation *)
-	let pb = pr_lconstr_env env sigma c in
-	let pb = if isCast c then surround pb else pb in
-	(str" := " ++ pb ++ cut () ) in
+let pr_compacted_decl env sigma decl =
+  let ids, pbody, typ = match decl with
+    | CompactedDecl.LocalAssum (ids, typ) ->
+       ids, mt (), typ
+    | CompactedDecl.LocalDef (ids,c,typ) ->
+       (* Force evaluation *)
+       let pb = pr_lconstr_env env sigma c in
+       let pb = if isCast c then surround pb else pb in
+       ids, (str" := " ++ pb ++ cut ()), typ
+  in
+  let pids = prlist_with_sep pr_comma pr_id ids in
   let pt = pr_ltype_env env sigma typ in
   let ptyp = (str" : " ++ pt) in
-  (pr_id id ++ hov 0 (pbody ++ ptyp))
+  hov 0 (pids ++ pbody ++ ptyp)
 
-let pr_var_decl env sigma d =
-  pr_var_decl_skel pr_id env sigma (Context.Named.Declaration.to_tuple d)
-
-let pr_var_list_decl env sigma (l,c,typ) =
-  hov 0 (pr_var_decl_skel (fun ids -> prlist_with_sep pr_comma pr_id ids) env sigma (l,c,typ))
+let pr_named_decl env sigma decl =
+  decl |> CompactedDecl.of_named_decl |> pr_compacted_decl env sigma
 
 let pr_rel_decl env sigma decl =
-  let open Context.Rel.Declaration in
-  let na = get_name decl in
-  let typ = get_type decl in
+  let na = RelDecl.get_name decl in
+  let typ = RelDecl.get_type decl in
   let pbody = match decl with
-    | LocalAssum _ -> mt ()
-    | LocalDef (_,c,_) ->
+    | RelDecl.LocalAssum _ -> mt ()
+    | RelDecl.LocalDef (_,c,_) ->
 	(* Force evaluation *)
 	let pb = pr_lconstr_env env sigma c in
 	let pb = if isCast c then surround pb else pb in
@@ -289,13 +292,13 @@ let pr_rel_decl env sigma decl =
 
 (* Prints a signature, all declarations on the same line if possible *)
 let pr_named_context_of env sigma =
-  let make_decl_list env d pps = pr_var_decl env sigma d :: pps in
+  let make_decl_list env d pps = pr_named_decl env sigma d :: pps in
   let psl = List.rev (fold_named_context make_decl_list env ~init:[]) in
   hv 0 (prlist_with_sep (fun _ -> ws 2) (fun x -> x) psl)
 
 let pr_named_context env sigma ne_context =
   hv 0 (Context.Named.fold_outside
-	  (fun d pps -> pps ++ ws 2 ++ pr_var_decl env sigma d)
+	  (fun d pps -> pps ++ ws 2 ++ pr_named_decl env sigma d)
           ne_context ~init:(mt ()))
 
 let pr_rel_context env sigma rel_context =
@@ -307,9 +310,9 @@ let pr_rel_context_of env sigma =
 (* Prints an env (variables and de Bruijn). Separator: newline *)
 let pr_context_unlimited env sigma =
   let sign_env =
-    Context.NamedList.fold
+    Context.Compacted.fold
       (fun d pps ->
-         let pidt =  pr_var_list_decl env sigma d in
+         let pidt =  pr_compacted_decl env sigma d in
          (pps ++ fnl () ++ pidt))
       (Termops.compact_named_context (named_context env)) ~init:(mt ())
   in
@@ -334,12 +337,12 @@ let pr_context_limit n env sigma =
   else
     let k = lgsign-n in
     let _,sign_env =
-      Context.NamedList.fold
+      Context.Compacted.fold
         (fun d (i,pps) ->
            if i < k then
 	     (i+1, (pps ++str "."))
 	   else
-             let pidt = pr_var_list_decl env sigma d in
+             let pidt = pr_compacted_decl env sigma d in
 	     (i+1, (pps ++ fnl () ++
 		      str (emacs_str "") ++
 		      pidt)))
@@ -417,14 +420,22 @@ let pr_evgl_sign sigma evi =
   | None -> [], []
   | Some f -> List.filter2 (fun b c -> not b) f (evar_context evi)
   in
-  let open Context.Named.Declaration in
-  let ids = List.rev_map get_id l in
+  let ids = List.rev_map NamedDecl.get_id l in
   let warn =
     if List.is_empty ids then mt () else
       (str "(" ++ prlist_with_sep pr_comma pr_id ids ++ str " cannot be used)")
   in
   let pc = pr_lconstr_env env sigma evi.evar_concl in
-  hov 0 (str"[" ++ ps ++ spc () ++ str"|- "  ++ pc ++ str"]" ++ spc () ++ warn)
+  let candidates =
+    match evi.evar_body, evi.evar_candidates with
+    | Evar_empty, Some l ->
+       spc () ++ str "= {" ++
+         prlist_with_sep (fun () -> str "|") (pr_lconstr_env env sigma) l ++ str "}"
+    | _ ->
+       mt ()
+  in
+  hov 0 (str"[" ++ ps ++ spc () ++ str"|- "  ++ pc ++ str"]" ++
+           candidates ++ spc () ++ warn)
 
 (* Print an existential variable *)
 
@@ -471,25 +482,91 @@ let default_pr_subgoal n sigma =
 
 let pr_internal_existential_key ev = str (string_of_existential ev)
 
-let emacs_print_dependent_evars sigma seeds =
+let print_evar_constraints gl sigma =
+  let pr_env =
+    match gl with
+    | None -> fun e' -> pr_context_of e' sigma
+    | Some g ->
+       let env = Goal.V82.env sigma g in fun e' ->
+       begin
+         if Context.Named.equal (named_context env) (named_context e') then
+           if Context.Rel.equal (rel_context env) (rel_context e') then mt ()
+           else pr_rel_context_of e' sigma ++ str " |-" ++ spc ()
+         else pr_context_of e' sigma ++ str " |-" ++ spc ()
+       end
+  in
+  let pr_evconstr (pbty,env,t1,t2) =
+    let t1 = Evarutil.nf_evar sigma t1
+    and t2 = Evarutil.nf_evar sigma t2 in
+    let env =
+      (** We currently allow evar instances to refer to anonymous de Bruijn
+          indices, so we protect the error printing code in this case by giving
+          names to every de Bruijn variable in the rel_context of the conversion
+          problem. MS: we should rather stop depending on anonymous variables, they
+          can be used to indicate independency. Also, this depends on a strategy for 
+          naming/renaming *)
+      Namegen.make_all_name_different env in
+    str" " ++
+      hov 2 (pr_env env ++ pr_lconstr_env env sigma t1 ++ spc () ++
+             str (match pbty with
+                  | Reduction.CONV -> "=="
+                  | Reduction.CUMUL -> "<=") ++
+             spc () ++ pr_lconstr_env env sigma t2)
+  in
+  let pr_candidate ev evi (candidates,acc) =
+    if Option.has_some evi.evar_candidates then
+      (succ candidates, acc ++ pr_evar sigma (ev,evi) ++ fnl ())
+    else (candidates, acc)
+  in
+  let constraints =
+    let _, cstrs = Evd.extract_all_conv_pbs sigma in
+    if List.is_empty cstrs then mt ()
+    else fnl () ++ str (String.plural (List.length cstrs) "unification constraint")
+         ++ str":" ++ fnl () ++ hov 0 (prlist_with_sep fnl pr_evconstr cstrs)
+  in
+  let candidates, ppcandidates = Evd.fold_undefined pr_candidate sigma (0,mt ()) in
+  constraints ++
+    if candidates > 0 then
+      fnl () ++ str (String.plural candidates "existential") ++
+        str" with candidates:" ++ fnl () ++ hov 0 ppcandidates
+    else mt ()
+
+let should_print_dependent_evars = ref false
+
+let _ =
+  let open Goptions in
+  declare_bool_option
+    { optsync  = true;
+      optdepr  = false;
+      optname  = "Printing Dependent Evars Line";
+      optkey   = ["Printing";"Dependent";"Evars";"Line"];
+      optread  = (fun () -> !should_print_dependent_evars);
+      optwrite = (fun v -> should_print_dependent_evars := v) }
+
+let print_dependent_evars gl sigma seeds =
+  let constraints = print_evar_constraints gl sigma in
   let evars () =
-    let evars = Evarutil.gather_dependent_evars sigma seeds in
-    let evars =
-      Evar.Map.fold begin fun e i s ->
-	let e' = pr_internal_existential_key e in
-	match i with
-	| None -> s ++ str" " ++ e' ++ str " open,"
-	| Some i ->
-	  s ++ str " " ++ e' ++ str " using " ++
-	    Evar.Set.fold begin fun d s ->
-	      pr_internal_existential_key d ++ str " " ++ s
-	    end i (str ",")
-      end evars (str "")
+    if !should_print_dependent_evars then
+      let evars = Evarutil.gather_dependent_evars sigma seeds in
+      let evars =
+	Evar.Map.fold begin fun e i s ->
+	  let e' = pr_internal_existential_key e in
+	  match i with
+	  | None -> s ++ str" " ++ e' ++ str " open,"
+	  | Some i ->
+	    s ++ str " " ++ e' ++ str " using " ++
+	      Evar.Set.fold begin fun d s ->
+		pr_internal_existential_key d ++ str " " ++ s
+	      end i (str ",")
+	end evars (str "")
     in
     fnl () ++
     str "(dependent evars:" ++ evars ++ str ")" ++ fnl ()
+    else
+      fnl () ++
+	str "(dependent evars: (printing disabled) )" ++ fnl ()
   in
-  delayed_emacs_cmd evars
+  constraints ++ delayed_emacs_cmd evars
 
 (* Print open subgoals. Checks for uninstantiated existential variables *)
 (* spiwack: [seeds] is for printing dependent evars in emacs mode. *)
@@ -557,12 +634,12 @@ let default_pr_subgoals ?(pr_first=true) close_cmd sigma seeds shelf stack goals
 	let exl = Evarutil.non_instantiated sigma in
 	if Evar.Map.is_empty exl then
 	  (str"No more subgoals."
-	   ++ emacs_print_dependent_evars sigma seeds)
+	   ++ print_dependent_evars None sigma seeds)
 	else
 	  let pei = pr_evars_int sigma 1 exl in
 	  (str "No more subgoals, but there are non-instantiated existential variables:"
 	   ++ fnl () ++ (hov 0 pei)
-	   ++ emacs_print_dependent_evars sigma seeds ++ fnl () ++
+	   ++ print_dependent_evars None sigma seeds ++ fnl () ++
            str "You can use Grab Existential Variables.")
       end
   | [g] when not !Flags.print_emacs && pr_first ->
@@ -570,7 +647,7 @@ let default_pr_subgoals ?(pr_first=true) close_cmd sigma seeds shelf stack goals
       v 0 (
 	str "1" ++ focused_if_needed ++ str"subgoal" ++ print_extra
         ++ pr_goal_tag g ++ pr_goal_name sigma g ++ cut () ++ pg
-	++ emacs_print_dependent_evars sigma seeds
+	++ print_dependent_evars (Some g) sigma seeds
       )
   | g1::rest ->
       let goals = print_multiple_goals g1 rest in
@@ -582,7 +659,7 @@ let default_pr_subgoals ?(pr_first=true) close_cmd sigma seeds shelf stack goals
         ++ pr_goal_tag g1
         ++ pr_goal_name sigma g1 ++ cut ()
 	++ goals
-	++ emacs_print_dependent_evars sigma seeds
+	++ print_dependent_evars (Some g1) sigma seeds
       )
 
 (**********************************************************************)
@@ -686,9 +763,6 @@ let pr_prim_rule = function
       str(if Termops.occur_meta c then "refine " else "exact ") ++
       Constrextern.with_meta_as_hole pr_constr c
 
-  | Move (id1,id2) ->
-      (str"move "  ++ pr_id id1 ++ Miscprint.pr_move_location pr_id id2)
-
 (* Backwards compatibility *)
 
 let prterm = pr_lconstr
@@ -697,9 +771,14 @@ let prterm = pr_lconstr
 (* Printer function for sets of Assumptions.assumptions.
    It is used primarily by the Print Assumptions command. *)
 
+type axiom =
+  | Constant of constant (* An axiom or a constant. *)
+  | Positive of MutInd.t (* A mutually inductive definition which has been assumed positive. *)
+  | Guarded of constant (* a constant whose (co)fixpoints have been assumed to be guarded *)
+
 type context_object =
   | Variable of Id.t (* A section variable or a Let definition *)
-  | Axiom of constant * (Label.t * Context.Rel.t * types) list
+  | Axiom of axiom * (Label.t * Context.Rel.t * types) list
   | Opaque of constant     (* An opaque constant. *)
   | Transparent of constant
 
@@ -707,12 +786,25 @@ type context_object =
 module OrderedContextObject =
 struct
   type t = context_object
+
+  let compare_axiom x y =
+    match x,y with
+    | Constant k1 , Constant k2 ->
+        con_ord k1 k2
+    | Positive m1 , Positive m2 ->
+        MutInd.CanOrd.compare m1 m2
+    | Guarded k1 , Guarded k2 ->
+        con_ord k1 k2
+    | _ , Constant _ -> 1
+    | _ , Positive _ -> 1
+    | _ -> -1
+
   let compare x y =
     match x , y with
     | Variable i1 , Variable i2 -> Id.compare i1 i2
     | Variable _ , _ -> -1
     | _ , Variable _ -> 1
-    | Axiom (k1,_) , Axiom (k2, _) -> con_ord k1 k2
+    | Axiom (k1,_) , Axiom (k2, _) -> compare_axiom k1 k2
     | Axiom _ , _ -> -1
     | _ , Axiom _ -> 1
     | Opaque k1 , Opaque k2 -> con_ord k1 k2
@@ -726,7 +818,7 @@ module ContextObjectMap = Map.Make (OrderedContextObject)
 
 let pr_assumptionset env s =
   if ContextObjectMap.is_empty s &&
-       engagement env = (PredicativeSet, StratifiedType) then
+       engagement env = PredicativeSet then
     str "Closed under the global context"
   else
     let safe_pr_constant env kn =
@@ -737,13 +829,22 @@ let pr_assumptionset env s =
     in
     let safe_pr_ltype typ =
       try str " : " ++ pr_ltype typ
-      with e when Errors.noncritical e -> mt ()
+      with e when CErrors.noncritical e -> mt ()
     in
     let safe_pr_ltype_relctx (rctx, typ) =
       let sigma, env = get_current_context () in
       let env = Environ.push_rel_context rctx env in
       try str " " ++ pr_ltype_env env sigma typ
-      with e when Errors.noncritical e -> mt ()
+      with e when CErrors.noncritical e -> mt ()
+    in
+    let pr_axiom env ax typ =
+      match ax with
+      | Constant kn ->
+          safe_pr_constant env kn ++ safe_pr_ltype typ
+      | Positive m ->
+          hov 2 (MutInd.print m ++ spc () ++ strbrk"is positive.")
+      | Guarded kn ->
+          hov 2 (safe_pr_constant env kn ++ spc () ++ strbrk"is positive.")
     in
     let fold t typ accu =
       let (v, a, o, tr) = accu in
@@ -751,11 +852,11 @@ let pr_assumptionset env s =
       | Variable id ->
         let var = pr_id id ++ str " : " ++ pr_ltype typ in
         (var :: v, a, o, tr)
-      | Axiom (kn,[]) ->
-        let ax = safe_pr_constant env kn ++ safe_pr_ltype typ in
+      | Axiom (axiom, []) ->
+        let ax = pr_axiom env axiom typ in
         (v, ax :: a, o, tr)
-      | Axiom (kn,l) ->
-        let ax = safe_pr_constant env kn ++ safe_pr_ltype typ ++
+      | Axiom (axiom,l) ->
+        let ax = pr_axiom env axiom typ ++
           cut() ++
           prlist_with_sep cut (fun (lbl, ctx, ty) ->
             str " used in " ++ pr_label lbl ++
@@ -811,4 +912,3 @@ let pr_polymorphic b =
 let pr_universe_instance evd ctx =
   let inst = Univ.UContext.instance ctx in
     str"@{" ++ Univ.Instance.pr (Evd.pr_evd_level evd) inst ++ str"}"
-
diff --git a/printing/printer.mli b/printing/printer.mli
index 70993bb72..20032012a 100644
--- a/printing/printer.mli
+++ b/printing/printer.mli
@@ -108,8 +108,8 @@ val pr_pconstructor        : env -> pconstructor -> std_ppcmds
 val pr_context_unlimited   : env -> evar_map -> std_ppcmds
 val pr_ne_context_of       : std_ppcmds -> env -> evar_map -> std_ppcmds
 
-val pr_var_decl            : env -> evar_map -> Context.Named.Declaration.t -> std_ppcmds
-val pr_var_list_decl       : env -> evar_map -> Context.NamedList.Declaration.t -> std_ppcmds
+val pr_named_decl          : env -> evar_map -> Context.Named.Declaration.t -> std_ppcmds
+val pr_compacted_decl      : env -> evar_map -> Context.Compacted.Declaration.t -> std_ppcmds
 val pr_rel_decl            : env -> evar_map -> Context.Rel.Declaration.t -> std_ppcmds
 
 val pr_named_context       : env -> evar_map -> Context.Named.t -> std_ppcmds
@@ -161,12 +161,16 @@ val prterm                 : constr -> std_ppcmds (** = pr_lconstr *)
 
 
 (** Declarations for the "Print Assumption" command *)
+type axiom =
+  | Constant of constant (* An axiom or a constant. *)
+  | Positive of MutInd.t (* A mutually inductive definition which has been assumed positive. *)
+  | Guarded of constant (* a constant whose (co)fixpoints have been assumed to be guarded *)
+
 type context_object =
-  | Variable of Id.t  (** A section variable or a Let definition *)
-  (** An axiom and the type it inhabits (if an axiom of the empty type) *)
-  | Axiom of constant * (Label.t * Context.Rel.t * types) list
-  | Opaque of constant      (** An opaque constant. *)
-  | Transparent of constant (** A transparent constant *)
+  | Variable of Id.t (* A section variable or a Let definition *)
+  | Axiom of axiom * (Label.t * Context.Rel.t * types) list
+  | Opaque of constant     (* An opaque constant. *)
+  | Transparent of constant
 
 module ContextObjectSet : Set.S with type elt = context_object
 module ContextObjectMap : CMap.ExtS
diff --git a/printing/printing.mllib b/printing/printing.mllib
index 652a34fa1..b0141b6d3 100644
--- a/printing/printing.mllib
+++ b/printing/printing.mllib
@@ -2,12 +2,7 @@ Genprint
 Pputils
 Ppannotation
 Ppconstr
-Ppconstrsig
 Printer
-Pptactic
-Pptacticsig
 Printmod
 Prettyp
 Ppvernac
-Ppvernacsig
-Richprinter
diff --git a/printing/printmod.ml b/printing/printmod.ml
index 5f98eeeab..dfa66d437 100644
--- a/printing/printmod.ml
+++ b/printing/printmod.ml
@@ -247,19 +247,24 @@ let get_typ_expr_alg mtb = match mtb.mod_type_alg with
   | _ -> raise Not_found
 
 let nametab_register_modparam mbid mtb =
+  let id = MBId.to_id mbid in
   match mtb.mod_type with
-  | MoreFunctor _ -> () (* functorial param : nothing to register *)
+  | MoreFunctor _ -> id (* functorial param : nothing to register *)
   | NoFunctor struc ->
     (* We first try to use the algebraic type expression if any,
        via a Declaremods function that converts back to module entries *)
     try
-      Declaremods.process_module_binding mbid (get_typ_expr_alg mtb)
-    with e when Errors.noncritical e ->
+      let () = Declaremods.process_module_binding mbid (get_typ_expr_alg mtb) in
+      id
+    with e when CErrors.noncritical e ->
       (* Otherwise, we try to play with the nametab ourselves *)
       let mp = MPbound mbid in
-      let dir = DirPath.make [MBId.to_id mbid] in
+      let check id = Nametab.exists_dir (DirPath.make [id]) in
+      let id = Namegen.next_ident_away_from id check in
+      let dir = DirPath.make [id] in
       nametab_register_dir mp;
-      List.iter (nametab_register_body mp dir) struc
+      List.iter (nametab_register_body mp dir) struc;
+      id
 
 let print_body is_impl env mp (l,body) =
   let name = pr_label l in
@@ -295,7 +300,7 @@ let print_body is_impl env mp (l,body) =
       try
 	let env = Option.get env in
 	pr_mutual_inductive_body env (MutInd.make2 mp l) mib
-      with e when Errors.noncritical e ->
+      with e when CErrors.noncritical e ->
         let keyword =
           let open Decl_kinds in
           match mib.mind_finite with
@@ -353,7 +358,7 @@ let print_mod_expr env mp locals = function
 let rec print_functor fty fatom is_type env mp locals = function
   |NoFunctor me -> fatom is_type env mp locals me
   |MoreFunctor (mbid,mtb1,me2) ->
-      nametab_register_modparam mbid mtb1;
+      let id = nametab_register_modparam mbid mtb1 in
       let mp1 = MPbound mbid in
       let pr_mtb1 = fty env mp1 locals mtb1 in
       let env' = Option.map (Modops.add_module_type mp1 mtb1) env in
@@ -361,7 +366,7 @@ let rec print_functor fty fatom is_type env mp locals = function
       let kwd = if is_type then "Funsig" else "Functor" in
       hov 2
         (keyword kwd ++ spc () ++
-	 str "(" ++ pr_id (MBId.to_id mbid) ++ str ":" ++ pr_mtb1 ++ str ")" ++
+	 str "(" ++ pr_id id ++ str ":" ++ pr_mtb1 ++ str ")" ++
 	 spc() ++ print_functor fty fatom is_type env' mp locals' me2)
 
 let rec print_expression x =
@@ -422,7 +427,7 @@ let print_module with_body mp =
   try
     if !short then raise ShortPrinting;
     unsafe_print_module (Some (Global.env ())) mp with_body me ++ fnl ()
-  with e when Errors.noncritical e ->
+  with e when CErrors.noncritical e ->
     unsafe_print_module None mp with_body me ++ fnl ()
 
 let print_modtype kn =
@@ -433,7 +438,7 @@ let print_modtype kn =
      (try
 	if !short then raise ShortPrinting;
 	print_signature' true (Some (Global.env ())) kn mtb.mod_type
-      with e when Errors.noncritical e ->
+      with e when CErrors.noncritical e ->
 	print_signature' true None kn mtb.mod_type))
 
 end
diff --git a/proofs/clenv.ml b/proofs/clenv.ml
index 1ef0b087b..fad656223 100644
--- a/proofs/clenv.ml
+++ b/proofs/clenv.ml
@@ -7,7 +7,7 @@
 (************************************************************************)
 
 open Pp
-open Errors
+open CErrors
 open Util
 open Names
 open Nameops
@@ -72,7 +72,7 @@ let clenv_get_type_of ce c = Retyping.get_type_of (cl_env ce) (cl_sigma ce) c
 exception NotExtensibleClause
 
 let clenv_push_prod cl =
-  let typ = whd_betadeltaiota (cl_env cl) (cl_sigma cl) (clenv_type cl) in
+  let typ = whd_all (cl_env cl) (cl_sigma cl) (clenv_type cl) in
   let rec clrec typ = match kind_of_term typ with
     | Cast (t,_,_) -> clrec t
     | Prod (na,t,u) ->
@@ -109,7 +109,7 @@ let clenv_environments evd bound t =
       | (n, Cast (t,_,_)) -> clrec (e,metas) n t
       | (n, Prod (na,t1,t2)) ->
 	  let mv = new_meta () in
-	  let dep = dependent (mkRel 1) t2 in
+	  let dep = not (noccurn 1 t2) in
 	  let na' = if dep then na else Anonymous in
 	  let e' = meta_declare mv t1 ~name:na' e in
 	  clrec (e', (mkMeta mv)::metas) (Option.map ((+) (-1)) n)
@@ -155,7 +155,7 @@ let error_incompatible_inst clenv mv  =
   let na = meta_name clenv.evd mv in
   match na with
       Name id ->
-        errorlabstrm "clenv_assign"
+        user_err ~hdr:"clenv_assign"
           (str "An incompatible instantiation has already been found for " ++
            pr_id id)
     | _ ->
@@ -417,11 +417,11 @@ let qhyp_eq h1 h2 = match h1, h2 with
 let check_bindings bl =
   match List.duplicates qhyp_eq (List.map pi2 bl) with
     | NamedHyp s :: _ ->
-	errorlabstrm ""
+	user_err 
 	  (str "The variable " ++ pr_id s ++
 	   str " occurs more than once in binding list.");
     | AnonHyp n :: _ ->
-	errorlabstrm ""
+	user_err 
 	  (str "The position " ++ int n ++
 	   str " occurs more than once in binding list.")
     | [] -> ()
@@ -435,7 +435,7 @@ let explain_no_such_bound_variable evd id =
     if na != Anonymous then out_name na :: l else l
   in
   let mvl = List.fold_left fold [] (Evd.meta_list evd) in
-  errorlabstrm "Evd.meta_with_name"
+  user_err ~hdr:"Evd.meta_with_name"
     (str"No such bound variable " ++ pr_id id ++
      (if mvl == [] then str " (no bound variables at all in the expression)."
       else
@@ -460,7 +460,7 @@ let meta_with_name evd id =
     | ([n],_|_,[n]) ->
         n
     | _  ->
-        errorlabstrm "Evd.meta_with_name"
+        user_err ~hdr:"Evd.meta_with_name"
           (str "Binder name \"" ++ pr_id id ++
            strbrk "\" occurs more than once in clause.")
 
@@ -469,12 +469,12 @@ let meta_of_binder clause loc mvs = function
   | AnonHyp n ->
       try List.nth mvs (n-1)
       with (Failure _|Invalid_argument _) ->
-        errorlabstrm "" (str "No such binder.")
+        user_err  (str "No such binder.")
 
 let error_already_defined b =
   match b with
     | NamedHyp id ->
-        errorlabstrm ""
+        user_err 
           (str "Binder name \"" ++ pr_id id ++
            str"\" already defined with incompatible value.")
     | AnonHyp n ->
@@ -491,7 +491,8 @@ let clenv_unify_binding_type clenv c t u =
       let evd,c = w_coerce_to_type (cl_env clenv) clenv.evd c t u in
       TypeProcessed, { clenv with evd = evd }, c
     with 
-      | PretypeError (_,_,ActualTypeNotCoercible (_,_,NotClean _)) as e ->
+      | PretypeError (_,_,ActualTypeNotCoercible (_,_,
+          (NotClean _ | ConversionFailed _))) as e ->
 	  raise e
       | e when precatchable_exception e ->
 	  TypeNotProcessed, clenv, c
@@ -526,7 +527,7 @@ let clenv_constrain_last_binding c clenv =
   clenv_assign_binding clenv k c
 
 let error_not_right_number_missing_arguments n =
-  errorlabstrm ""
+  user_err 
     (strbrk "Not the right number of missing arguments (expected " ++
       int n ++ str ").")
 
@@ -640,7 +641,7 @@ let explain_no_such_bound_variable holes id =
   | [id] -> str "(possible name is: " ++ pr_id id ++ str ")."
   | _ -> str "(possible names are: " ++ pr_enum pr_id mvl ++ str ")."
   in
-  errorlabstrm "" (str "No such bound variable " ++ pr_id id ++ expl)
+  user_err  (str "No such bound variable " ++ pr_id id ++ expl)
 
 let evar_with_name holes id =
   let map h = match h.hole_name with
@@ -652,7 +653,7 @@ let evar_with_name holes id =
   | [] -> explain_no_such_bound_variable holes id
   | [h] -> h.hole_evar
   | _ ->
-    errorlabstrm ""
+    user_err 
       (str "Binder name \"" ++ pr_id id ++
         str "\" occurs more than once in clause.")
 
@@ -662,8 +663,8 @@ let evar_of_binder holes = function
   try
     let h = List.nth holes (pred n) in
     h.hole_evar
-  with e when Errors.noncritical e ->
-    errorlabstrm "" (str "No such binder.")
+  with e when CErrors.noncritical e ->
+    user_err  (str "No such binder.")
 
 let define_with_type sigma env ev c =
   let t = Retyping.get_type_of env sigma ev in
diff --git a/proofs/clenv.mli b/proofs/clenv.mli
index 59b166ea0..e9236b1da 100644
--- a/proofs/clenv.mli
+++ b/proofs/clenv.mli
@@ -6,6 +6,10 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
+(** This file defines clausenv, which is a deprecated way to handle open terms
+    in the proof engine. Most of the API here is legacy except for the
+    evar-based clauses. *)
+
 open Names
 open Term
 open Environ
diff --git a/proofs/clenvtac.ml b/proofs/clenvtac.ml
index 08e6c91de..98b5bc8b0 100644
--- a/proofs/clenvtac.ml
+++ b/proofs/clenvtac.ml
@@ -59,6 +59,19 @@ let clenv_pose_dependent_evars with_evars clenv =
       (RefinerError (UnresolvedBindings (List.map (meta_name clenv.evd) dep_mvs)));
   clenv_pose_metas_as_evars clenv dep_mvs
 
+(** Use our own fast path, more informative than from Typeclasses *)
+let check_tc evd =
+  let has_resolvable = ref false in
+  let check _ evi =
+    let res = Typeclasses.is_resolvable evi in
+    if res then
+      let () = has_resolvable := true in
+      Typeclasses.is_class_evar evd evi
+    else false
+  in
+  let has_typeclass = Evar.Map.exists check (Evd.undefined_map evd) in
+  (has_typeclass, !has_resolvable)
+
 let clenv_refine with_evars ?(with_classes=true) clenv =
   (** ppedrot: a Goal.enter here breaks things, because the tactic below may
       solve goals by side effects, while the compatibility layer keeps those
@@ -67,9 +80,16 @@ let clenv_refine with_evars ?(with_classes=true) clenv =
   let clenv = clenv_pose_dependent_evars with_evars clenv in
   let evd' =
     if with_classes then
-      let evd' = Typeclasses.resolve_typeclasses ~filter:Typeclasses.all_evars
-        ~fail:(not with_evars) clenv.env clenv.evd
-      in Typeclasses.mark_unresolvables ~filter:Typeclasses.all_goals evd'
+      let (has_typeclass, has_resolvable) = check_tc clenv.evd in
+      let evd' =
+        if has_typeclass then
+          Typeclasses.resolve_typeclasses ~fast_path:false ~filter:Typeclasses.all_evars
+          ~fail:(not with_evars) clenv.env clenv.evd
+        else clenv.evd
+      in
+      if has_resolvable then
+        Typeclasses.mark_unresolvables ~filter:Typeclasses.all_goals evd'
+      else evd'
     else clenv.evd
   in
   let clenv = { clenv with evd = evd' } in
@@ -120,10 +140,10 @@ let fail_quick_unif_flags = {
 let unify ?(flags=fail_quick_unif_flags) m =
   Proofview.Goal.enter { enter = begin fun gl ->
     let env = Tacmach.New.pf_env gl in
-    let n = Tacmach.New.pf_nf_concl gl in
+    let n = Tacmach.New.pf_concl (Proofview.Goal.assume gl) in
     let evd = clear_metas (Tacmach.New.project gl) in
     try
       let evd' = w_unify env evd CONV ~flags m n in
 	Proofview.Unsafe.tclEVARSADVANCE evd'
-    with e when Errors.noncritical e -> Proofview.tclZERO e
+    with e when CErrors.noncritical e -> Proofview.tclZERO e
   end }
diff --git a/proofs/clenvtac.mli b/proofs/clenvtac.mli
index 00e74a247..8a096b645 100644
--- a/proofs/clenvtac.mli
+++ b/proofs/clenvtac.mli
@@ -6,10 +6,12 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
+(** Legacy components of the previous proof engine. *)
+
 open Term
 open Clenv
-open Tacexpr
 open Unification
+open Misctypes
 
 (** Tactics *)
 val unify : ?flags:unify_flags -> constr -> unit Proofview.tactic
diff --git a/proofs/evar_refiner.ml b/proofs/evar_refiner.ml
index 3192a6a29..509efbc5b 100644
--- a/proofs/evar_refiner.ml
+++ b/proofs/evar_refiner.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-open Errors
+open CErrors
 open Util
 open Names
 open Evd
@@ -46,16 +46,16 @@ let w_refine (evk,evi) (ltac_var,rawc) sigma =
   let sigma',typed_c =
     let flags = {
       Pretyping.use_typeclasses = true;
-      Pretyping.use_unif_heuristics = true;
+      Pretyping.solve_unification_constraints = true;
       Pretyping.use_hook = None;
       Pretyping.fail_evar = false;
       Pretyping.expand_evars = true } in
     try Pretyping.understand_ltac flags
       env sigma ltac_var (Pretyping.OfType evi.evar_concl) rawc
-    with e when Errors.noncritical e ->
+    with e when CErrors.noncritical e ->
       let loc = Glob_ops.loc_of_glob_constr rawc in
-      user_err_loc
-        (loc,"", str "Instance is not well-typed in the environment of " ++
-                 str (string_of_existential evk))
+      user_err ~loc 
+                (str "Instance is not well-typed in the environment of " ++
+                 pr_existential_key sigma evk ++ str ".")
   in
   define_and_solve_constraints evk typed_c env (evars_reset_evd sigma' sigma)
diff --git a/proofs/goal.ml b/proofs/goal.ml
index 111a947a9..a141708c2 100644
--- a/proofs/goal.ml
+++ b/proofs/goal.ml
@@ -10,7 +10,8 @@ open Util
 open Pp
 open Term
 open Sigma.Notations
-open Context.Named.Declaration
+
+module NamedDecl = Context.Named.Declaration
 
 (* This module implements the abstract interface to goals *)
 (* A general invariant of the module, is that a goal whose associated
@@ -77,7 +78,7 @@ module V82 = struct
     let evars = Sigma.to_evar_map evars in
     let evars = Evd.restore_future_goals evars prev_future_goals prev_principal_goal in
     let ctxt = Environ.named_context_of_val hyps in
-    let inst = Array.map_of_list (mkVar % get_id) ctxt in
+    let inst = Array.map_of_list (NamedDecl.get_id %> mkVar) ctxt in
     let ev = Term.mkEvar (evk,inst) in
     (evk, ev, evars)
 
@@ -148,7 +149,7 @@ module V82 = struct
     let env = env sigma gl in
     let genv = Global.env () in
     let is_proof_var decl =
-      try ignore (Environ.lookup_named (get_id decl) genv); false
+      try ignore (Environ.lookup_named (NamedDecl.get_id decl) genv); false
       with Not_found -> true in
     Environ.fold_named_context_reverse (fun t decl ->
 					  if is_proof_var decl then
diff --git a/proofs/goal.mli b/proofs/goal.mli
index 8a3d6e815..6a79c1f45 100644
--- a/proofs/goal.mli
+++ b/proofs/goal.mli
@@ -6,7 +6,9 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* This module implements the abstract interface to goals *)
+(** This module implements the abstract interface to goals. Most of the code
+    here is useless and should be eventually removed. Consider using
+    {!Proofview.Goal} instead. *)
 
 type goal = Evar.t
 
diff --git a/proofs/logic.ml b/proofs/logic.ml
index fd8a70c65..44c629484 100644
--- a/proofs/logic.ml
+++ b/proofs/logic.ml
@@ -7,7 +7,7 @@
 (************************************************************************)
 
 open Pp
-open Errors
+open CErrors
 open Util
 open Names
 open Nameops
@@ -24,6 +24,8 @@ open Retyping
 open Misctypes
 open Context.Named.Declaration
 
+module NamedDecl = Context.Named.Declaration
+
 type refiner_error =
 
   (* Errors raised by the refiner *)
@@ -59,7 +61,7 @@ let is_unification_error = function
 | _ -> false
 
 let catchable_exception = function
-  | Errors.UserError _ | TypeError _
+  | CErrors.UserError _ | TypeError _
   | RefinerError _ | Indrec.RecursionSchemeError _
   | Nametab.GlobalizationError _
   (* reduction errors *)
@@ -151,7 +153,7 @@ let reorder_context env sign ord =
       | top::ord' when mem_q top moved_hyps ->
           let ((d,h),mh) = find_q top moved_hyps in
           if occur_vars_in_decl env h d then
-            errorlabstrm "reorder_context"
+            user_err ~hdr:"reorder_context"
               (str "Cannot move declaration " ++ pr_id top ++ spc() ++
               str "before " ++
               pr_sequence pr_id
@@ -162,7 +164,7 @@ let reorder_context env sign ord =
           (match ctxt_head with
             | [] -> error_no_such_hypothesis (List.hd ord)
             | d :: ctxt ->
-                let x = get_id d in
+                let x = NamedDecl.get_id d in
                 if Id.Set.mem x expected then
                   step ord (Id.Set.remove x expected)
                     ctxt (push_item x d moved_hyps) ctxt_tail
@@ -178,11 +180,11 @@ let reorder_val_context env sign ord =
 
 
 let check_decl_position env sign d =
-  let x = get_id d in
+  let x = NamedDecl.get_id d in
   let needed = global_vars_set_of_decl env d in
   let deps = dependency_closure env (named_context_of_val sign) needed in
   if Id.List.mem x deps then
-    errorlabstrm "Logic.check_decl_position"
+    user_err ~hdr:"Logic.check_decl_position"
       (str "Cannot create self-referring hypothesis " ++ pr_id x);
   x::deps
 
@@ -204,8 +206,8 @@ let move_location_eq m1 m2 = match m1, m2 with
 let rec get_hyp_after h = function
   | [] -> error_no_such_hypothesis h
   | d :: right ->
-      if Id.equal (get_id d) h then
-	match right with d' ::_ -> MoveBefore (get_id d') | [] -> MoveFirst
+      if Id.equal (NamedDecl.get_id d) h then
+	match right with d' ::_ -> MoveBefore (NamedDecl.get_id d') | [] -> MoveFirst
       else
        get_hyp_after h right
 
@@ -213,7 +215,7 @@ let split_sign hfrom hto l =
   let rec splitrec left toleft = function
     | [] -> error_no_such_hypothesis hfrom
     | d :: right ->
-        let hyp,_,typ = to_tuple d in
+        let hyp = NamedDecl.get_id d in
       	if Id.equal hyp hfrom then
 	  (left,right,d, toleft || move_location_eq hto MoveLast)
       	else
@@ -235,24 +237,24 @@ let move_hyp toleft (left,declfrom,right) hto =
   let env = Global.env() in
   let test_dep d d2 =
     if toleft
-    then occur_var_in_decl env (get_id d2) d
-    else occur_var_in_decl env (get_id d) d2
+    then occur_var_in_decl env (NamedDecl.get_id d2) d
+    else occur_var_in_decl env (NamedDecl.get_id d) d2
   in
   let rec moverec first middle = function
     | [] ->
 	if match hto with MoveFirst | MoveLast -> false | _ -> true then
 	  error_no_such_hypothesis (hyp_of_move_location hto);
 	List.rev first @ List.rev middle
-    | d :: _ as right when move_location_eq hto (MoveBefore (get_id d)) ->
+    | d :: _ as right when move_location_eq hto (MoveBefore (NamedDecl.get_id d)) ->
 	List.rev first @ List.rev middle @ right
     | d :: right ->
-        let hyp = get_id d in
+        let hyp = NamedDecl.get_id d in
 	let (first',middle') =
       	  if List.exists (test_dep d) middle then
 	    if not (move_location_eq hto (MoveAfter hyp)) then
 	      (first, d::middle)
             else
-	      errorlabstrm "move_hyp" (str "Cannot move " ++ pr_id (get_id declfrom) ++
+	      user_err ~hdr:"move_hyp" (str "Cannot move " ++ pr_id (NamedDecl.get_id declfrom) ++
 	        Miscprint.pr_move_location pr_id hto ++
 	        str (if toleft then ": it occurs in " else ": it depends on ")
 	        ++ pr_id hyp ++ str ".")
@@ -276,6 +278,11 @@ let move_hyp toleft (left,declfrom,right) hto =
     List.fold_left (fun sign d -> push_named_context_val d sign)
       right left
 
+let move_hyp_in_named_context hfrom hto sign =
+  let (left,right,declfrom,toleft) =
+    split_sign hfrom hto (named_context_of_val sign) in
+  move_hyp toleft (left,declfrom,right) hto
+
 (**********************************************************************)
 
 
@@ -287,7 +294,7 @@ let move_hyp toleft (left,declfrom,right) hto =
 variables only in Application and Case *)
 
 let error_unsupported_deep_meta c =
-  errorlabstrm "" (strbrk "Application of lemmas whose beta-iota normal " ++
+  user_err  (strbrk "Application of lemmas whose beta-iota normal " ++
     strbrk "form contains metavariables deep inside the term is not " ++
     strbrk "supported; try \"refine\" instead.")
 
@@ -295,9 +302,9 @@ let collect_meta_variables c =
   let rec collrec deep acc c = match kind_of_term c with
     | Meta mv -> if deep then error_unsupported_deep_meta () else mv::acc
     | Cast(c,_,_) -> collrec deep acc c
-    | (App _| Case _) -> fold_constr (collrec deep) acc c
+    | (App _| Case _) -> Term.fold_constr (collrec deep) acc c
     | Proj (_, c) -> collrec deep acc c
-    | _ -> fold_constr (collrec true) acc c
+    | _ -> Term.fold_constr (collrec true) acc c
   in
   List.rev (collrec false [] c)
 
@@ -463,7 +470,7 @@ and mk_hdgoals sigma goal goalacc trm =
 
 and mk_arggoals sigma goal goalacc funty allargs =
   let foldmap (goalacc, funty, sigma) harg =
-    let t = whd_betadeltaiota (Goal.V82.env sigma goal) sigma funty in
+    let t = whd_all (Goal.V82.env sigma goal) sigma funty in
     let rec collapse t = match kind_of_term t with
     | LetIn (_, c1, _, b) -> collapse (subst1 c1 b)
     | _ -> t
@@ -489,19 +496,20 @@ and mk_casegoals sigma goal goalacc p c =
 
 
 let convert_hyp check sign sigma d =
-  let id,b,bt = to_tuple d in
+  let id = NamedDecl.get_id d in
+  let b = NamedDecl.get_value d in
   let env = Global.env() in
   let reorder = ref [] in
   let sign' =
     apply_to_hyp check sign id
       (fun _ d' _ ->
-        let _,c,ct = to_tuple d' in
+        let c = NamedDecl.get_value d' in
         let env = Global.env_of_context sign in
-        if check && not (is_conv env sigma bt ct) then
-	  errorlabstrm "Logic.convert_hyp"
+        if check && not (is_conv env sigma (NamedDecl.get_type d) (NamedDecl.get_type d')) then
+	  user_err ~hdr:"Logic.convert_hyp"
             (str "Incorrect change of the type of " ++ pr_id id ++ str ".");
         if check && not (Option.equal (is_conv env sigma) b c) then
-	  errorlabstrm "Logic.convert_hyp"
+	  user_err ~hdr:"Logic.convert_hyp"
             (str "Incorrect change of the body of "++ pr_id id ++ str ".");
        if check then reorder := check_decl_position env sign d;
        d) in
@@ -533,8 +541,8 @@ let prim_refiner r sigma goal =
 	      nexthyp,
 	      t,cl,sigma
 	  else
-            (if !check && mem_named_context id (named_context_of_val sign) then
-	      errorlabstrm "Logic.prim_refiner"
+            (if !check && mem_named_context_val id sign then
+	      user_err ~hdr:"Logic.prim_refiner"
                 (str "Variable " ++ pr_id id ++ str " is already declared.");
 	     push_named_context_val (LocalAssum (id,t)) sign,t,cl,sigma) in
         let (sg2,ev2,sigma) = 
@@ -549,12 +557,3 @@ let prim_refiner r sigma goal =
 	let sgl = List.rev sgl in
 	let sigma = Goal.V82.partial_solution sigma goal oterm in
 	  (sgl, sigma)
-
-    | Move (hfrom, hto) ->
-  	let (left,right,declfrom,toleft) =
-	  split_sign hfrom hto (named_context_of_val sign) in
-  	let hyps' =
-	  move_hyp toleft (left,declfrom,right) hto in
-	let (gl,ev,sigma) = mk_goal hyps' cl in
-	let sigma = Goal.V82.partial_solution_to sigma goal gl ev in
-  	  ([gl], sigma)
diff --git a/proofs/logic.mli b/proofs/logic.mli
index 9aa4ac207..0dba9ef1e 100644
--- a/proofs/logic.mli
+++ b/proofs/logic.mli
@@ -6,6 +6,8 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
+(** Legacy proof engine. Do not use in newly written code. *)
+
 open Names
 open Term
 open Evd
@@ -54,3 +56,6 @@ val catchable_exception : exn -> bool
 
 val convert_hyp : bool -> Environ.named_context_val -> evar_map ->
   Context.Named.Declaration.t -> Environ.named_context_val
+
+val move_hyp_in_named_context : Id.t -> Id.t Misctypes.move_location ->
+  Environ.named_context_val -> Environ.named_context_val
diff --git a/proofs/pfedit.ml b/proofs/pfedit.ml
index 2863384b5..80bea0c3b 100644
--- a/proofs/pfedit.ml
+++ b/proofs/pfedit.ml
@@ -13,6 +13,17 @@ open Entries
 open Environ
 open Evd
 
+let use_unification_heuristics_ref = ref true
+let _ = Goptions.declare_bool_option {
+  Goptions.optsync = true; Goptions.optdepr = false;
+  Goptions.optname = "Solve unification constraints at every \".\"";
+  Goptions.optkey = ["Solve";"Unification";"Constraints"];
+  Goptions.optread = (fun () -> !use_unification_heuristics_ref);
+  Goptions.optwrite = (fun a -> use_unification_heuristics_ref:=a);
+}
+
+let use_unification_heuristics () = !use_unification_heuristics_ref
+
 let refining = Proof_global.there_are_pending_proofs
 let check_no_pending_proofs = Proof_global.check_no_pending_proof
 
@@ -39,7 +50,7 @@ let cook_this_proof p =
   match p with
   | { Proof_global.id;entries=[constr];persistence;universes } ->
       (id,(constr,universes,persistence))
-  | _ -> Errors.anomaly ~label:"Pfedit.cook_proof" (Pp.str "more than one proof term.")
+  | _ -> CErrors.anomaly ~label:"Pfedit.cook_proof" (Pp.str "more than one proof term.")
 
 let cook_proof () =
   cook_this_proof (fst
@@ -59,9 +70,9 @@ let get_universe_binders () =
   Proof_global.get_universe_binders ()
 
 exception NoSuchGoal
-let _ = Errors.register_handler begin function
-  | NoSuchGoal -> Errors.error "No such goal."
-  | _ -> raise Errors.Unhandled
+let _ = CErrors.register_handler begin function
+  | NoSuchGoal -> CErrors.error "No such goal."
+  | _ -> raise CErrors.Unhandled
 end
 let get_nth_V82_goal i =
   let p = Proof_global.give_me_the_proof () in
@@ -76,12 +87,12 @@ let get_goal_context_gen i =
 
 let get_goal_context i =
   try get_goal_context_gen i
-  with Proof_global.NoCurrentProof -> Errors.error "No focused proof."
-     | NoSuchGoal -> Errors.error "No such goal."
+  with Proof_global.NoCurrentProof -> CErrors.error "No focused proof."
+     | NoSuchGoal -> CErrors.error "No such goal."
 
 let get_current_goal_context () =
   try get_goal_context_gen 1
-  with Proof_global.NoCurrentProof -> Errors.error "No focused proof."
+  with Proof_global.NoCurrentProof -> CErrors.error "No focused proof."
      | NoSuchGoal -> 
     (* spiwack: returning empty evar_map, since if there is no goal, under focus,
         there is no accessible evar either *)
@@ -102,7 +113,7 @@ let get_current_context () =
 let current_proof_statement () =
   match Proof_global.V82.get_current_initial_conclusions () with
     | (id,([concl],strength)) -> id,strength,concl
-    | _ -> Errors.anomaly ~label:"Pfedit.current_proof_statement" (Pp.str "more than one statement")
+    | _ -> CErrors.anomaly ~label:"Pfedit.current_proof_statement" (Pp.str "more than one statement")
 
 let solve ?with_end_tac gi info_lvl tac pr =
   try 
@@ -115,9 +126,15 @@ let solve ?with_end_tac gi info_lvl tac pr =
     in
     let tac = match gi with
       | Vernacexpr.SelectNth i -> Proofview.tclFOCUS i i tac
+      | Vernacexpr.SelectList l -> Proofview.tclFOCUSLIST l tac
       | Vernacexpr.SelectId id -> Proofview.tclFOCUSID id tac
       | Vernacexpr.SelectAll -> tac
     in
+    let tac =
+      if use_unification_heuristics () then
+        Proofview.tclTHEN tac Refine.solve_constraints
+      else tac
+    in
     let (p,(status,info)) = Proof.run_tactic (Global.env ()) tac pr in
     let () =
       match info_lvl with
@@ -126,11 +143,11 @@ let solve ?with_end_tac gi info_lvl tac pr =
     in
     (p,status)
   with
-    | Proof_global.NoCurrentProof  -> Errors.error "No focused proof"
+    | Proof_global.NoCurrentProof  -> CErrors.error "No focused proof"
     | CList.IndexOutOfRange ->
         match gi with
 	| Vernacexpr.SelectNth i -> let msg = str "No such goal: " ++ int i ++ str "." in
-	                            Errors.errorlabstrm "" msg
+	                            CErrors.user_err  msg
         | _ -> assert false
 
 let by tac = Proof_global.with_current_proof (fun _ -> solve (Vernacexpr.SelectNth 1) None tac)
@@ -156,15 +173,16 @@ let build_constant_by_tactic id ctx sign ?(goal_kind = Global, false, Proof Theo
     delete_current_proof ();
     const, status, fst univs
   with reraise ->
-    let reraise = Errors.push reraise in
+    let reraise = CErrors.push reraise in
     delete_current_proof ();
     iraise reraise
 
-let build_by_tactic ?(side_eff=true) env ctx ?(poly=false) typ tac =
+let build_by_tactic ?(side_eff=true) env sigma ?(poly=false) typ tac =
   let id = Id.of_string ("temporary_proof"^string_of_int (next())) in
   let sign = val_of_named_context (named_context env) in
   let gk = Global, poly, Proof Theorem in
-  let ce, status, univs = build_constant_by_tactic id ctx sign ~goal_kind:gk typ tac in
+  let ce, status, univs =
+    build_constant_by_tactic id sigma sign ~goal_kind:gk typ tac in
   let ce =
     if side_eff then Safe_typing.inline_private_constants_in_definition_entry env ce
     else { ce with
@@ -187,7 +205,7 @@ let refine_by_tactic env sigma ty tac =
     try Proof.run_tactic env tac prf
     with Logic_monad.TacticFailure e as src ->
       (** Catch the inner error of the monad tactic *)
-      let (_, info) = Errors.push src in
+      let (_, info) = CErrors.push src in
       iraise (e, info)
   in
   (** Plug back the retrieved sigma *)
@@ -214,7 +232,7 @@ let refine_by_tactic env sigma ty tac =
 (* Support for resolution of evars in tactic interpretation, including
    resolution by application of tactics *)
 
-let implicit_tactic = ref None
+let implicit_tactic = Summary.ref None ~name:"implicit-tactic"
 
 let declare_implicit_tactic tac = implicit_tactic := Some tac
 
@@ -227,10 +245,13 @@ let solve_by_implicit_tactic env sigma evk =
       when
 	Context.Named.equal (Environ.named_context_of_val evi.evar_hyps)
 	(Environ.named_context env) ->
-      let tac = Proofview.tclTHEN tac (Proofview.tclEXTEND [] (Proofview.tclZERO (Errors.UserError ("",Pp.str"Proof is not complete."))) []) in
+      let tac = Proofview.tclTHEN tac (Proofview.tclEXTEND [] (Proofview.tclZERO (CErrors.UserError (None,Pp.str"Proof is not complete."))) []) in
       (try
-        let (ans, _, _) = 
-	  build_by_tactic env (Evd.evar_universe_context sigma) evi.evar_concl tac in
-        ans
+        let c = Evarutil.nf_evars_universes sigma evi.evar_concl in
+        if Evarutil.has_undefined_evars sigma c then raise Exit;
+        let (ans, _, ctx) =
+	  build_by_tactic env (Evd.evar_universe_context sigma) c tac in
+        let sigma = Evd.set_universe_context sigma ctx in
+        sigma, ans
        with e when Logic.catchable_exception e -> raise Exit)
   | _ -> raise Exit
diff --git a/proofs/pfedit.mli b/proofs/pfedit.mli
index cfab8bd63..7458109fa 100644
--- a/proofs/pfedit.mli
+++ b/proofs/pfedit.mli
@@ -6,6 +6,8 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
+(** Global proof state. A quite redundant wrapper on {!Proof_global}. *)
+
 open Loc
 open Names
 open Term
@@ -122,14 +124,14 @@ val get_all_proof_names : unit -> Id.t list
 (** [set_end_tac tac] applies tactic [tac] to all subgoal generate
     by [solve] *)
 
-val set_end_tac : Tacexpr.raw_tactic_expr -> unit
+val set_end_tac : Genarg.glob_generic_argument -> unit
 
 (** {6 ... } *)
 (** [set_used_variables l] declares that section variables [l] will be
     used in the proof *)
 val set_used_variables :
-  Id.t list -> Context.section_context * (Loc.t * Names.Id.t) list
-val get_used_variables : unit -> Context.section_context option
+  Id.t list -> Context.Named.t * (Loc.t * Names.Id.t) list
+val get_used_variables : unit -> Context.Named.t option
 
 (** {6 Universe binders } *)
 val get_universe_binders : unit -> universe_binders option
@@ -165,7 +167,8 @@ val instantiate_nth_evar_com : int -> Constrexpr.constr_expr -> unit
 val build_constant_by_tactic :
   Id.t -> Evd.evar_universe_context -> named_context_val -> ?goal_kind:goal_kind ->
   types -> unit Proofview.tactic -> 
-  Safe_typing.private_constants Entries.definition_entry * bool * Evd.evar_universe_context
+  Safe_typing.private_constants Entries.definition_entry * bool *
+    Evd.evar_universe_context
 
 val build_by_tactic : ?side_eff:bool -> env -> Evd.evar_universe_context -> ?poly:polymorphic ->
   types -> unit Proofview.tactic -> 
@@ -187,5 +190,4 @@ val declare_implicit_tactic : unit Proofview.tactic -> unit
 val clear_implicit_tactic : unit -> unit
 
 (* Raise Exit if cannot solve *)
-(* FIXME: interface: it may incur some new universes etc... *)
-val solve_by_implicit_tactic : env -> Evd.evar_map -> Evd.evar -> constr
+val solve_by_implicit_tactic : env -> Evd.evar_map -> Evd.evar -> Evd.evar_map * constr
diff --git a/proofs/proof.ml b/proofs/proof.ml
index 86af420dc..b2103489a 100644
--- a/proofs/proof.ml
+++ b/proofs/proof.ml
@@ -64,17 +64,17 @@ exception NoSuchGoals of int * int
 
 exception FullyUnfocused
 
-let _ = Errors.register_handler begin function
+let _ = CErrors.register_handler begin function
   | CannotUnfocusThisWay ->
-    Errors.error "This proof is focused, but cannot be unfocused this way"
+    CErrors.error "This proof is focused, but cannot be unfocused this way"
   | NoSuchGoals (i,j) when Int.equal i j ->
-      Errors.errorlabstrm "Focus" Pp.(str"No such goal (" ++ int i ++ str").")
+      CErrors.user_err ~hdr:"Focus" Pp.(str"No such goal (" ++ int i ++ str").")
   | NoSuchGoals (i,j) ->
-      Errors.errorlabstrm "Focus" Pp.(
+      CErrors.user_err ~hdr:"Focus" Pp.(
         str"Not every goal in range ["++ int i ++ str","++int j++str"] exist."
       )
-  | FullyUnfocused -> Errors.error "The proof is not focused"
-  | _ -> raise Errors.Unhandled
+  | FullyUnfocused -> CErrors.error "The proof is not focused"
+  | _ -> raise CErrors.Unhandled
 end
 
 let check_cond_kind c k =
@@ -300,12 +300,12 @@ exception UnfinishedProof
 exception HasShelvedGoals
 exception HasGivenUpGoals
 exception HasUnresolvedEvar
-let _ = Errors.register_handler begin function
-  | UnfinishedProof -> Errors.error "Some goals have not been solved."
-  | HasShelvedGoals -> Errors.error "Some goals have been left on the shelf."
-  | HasGivenUpGoals -> Errors.error "Some goals have been given up."
-  | HasUnresolvedEvar -> Errors.error "Some existential variables are uninstantiated."
-  | _ -> raise Errors.Unhandled
+let _ = CErrors.register_handler begin function
+  | UnfinishedProof -> CErrors.error "Some goals have not been solved."
+  | HasShelvedGoals -> CErrors.error "Some goals have been left on the shelf."
+  | HasGivenUpGoals -> CErrors.error "Some goals have been given up."
+  | HasUnresolvedEvar -> CErrors.error "Some existential variables are uninstantiated."
+  | _ -> raise CErrors.Unhandled
 end
 
 let return p =
@@ -351,7 +351,14 @@ let run_tactic env tac pr =
     Proofview.apply env tac sp
   in
   let sigma = Proofview.return proofview in
-  let shelf = (undef sigma pr.shelf)@retrieved@(undef sigma to_shelve) in
+  let to_shelve = undef sigma to_shelve in
+  let shelf = (undef sigma pr.shelf)@retrieved@to_shelve in
+  let proofview =
+    List.fold_left
+      Proofview.Unsafe.mark_as_unresolvable
+      proofview
+      to_shelve
+  in
   let given_up = pr.given_up@give_up in
   let proofview = Proofview.Unsafe.reset_future_goals proofview in
   { pr with proofview ; shelf ; given_up },(status,info_trace)
@@ -365,6 +372,22 @@ let in_proof p k = k (Proofview.return p.proofview)
 let unshelve p =
   { p with proofview = Proofview.unshelve (p.shelf) (p.proofview) ; shelf = [] }
 
+let pr_proof p =
+  let p = map_structured_proof p (fun _sigma g -> g) in
+  Pp.(
+    let pr_goal_list = prlist_with_sep spc Goal.pr_goal in
+    let rec aux acc = function
+      | [] -> acc
+      | (before,after)::stack ->
+         aux (pr_goal_list before ++ spc () ++ str "{" ++ acc ++ str "}" ++ spc () ++
+              pr_goal_list after) stack in
+    str "[" ++ str "focus structure: " ++
+               aux (pr_goal_list p.fg_goals) p.bg_goals ++ str ";" ++ spc () ++
+    str "shelved: " ++ pr_goal_list p.shelved_goals ++ str ";" ++ spc () ++
+    str "given up: " ++ pr_goal_list p.given_up_goals ++
+    str "]"
+  )
+
 (*** Compatibility layer with <=v8.2 ***)
 module V82 = struct
   let subgoals p =
@@ -397,9 +420,9 @@ module V82 = struct
         let evl = Evarutil.non_instantiated sigma in
         let evl = Evar.Map.bindings evl in
         if (n <= 0) then
-          Errors.error "incorrect existential variable index"
+          CErrors.error "incorrect existential variable index"
         else if CList.length evl < n then
-          Errors.error "not so many uninstantiated existential variables"
+          CErrors.error "not so many uninstantiated existential variables"
         else
           CList.nth evl (n-1)
       in
diff --git a/proofs/proof.mli b/proofs/proof.mli
index 5053fc7fb..8dc165e72 100644
--- a/proofs/proof.mli
+++ b/proofs/proof.mli
@@ -182,6 +182,8 @@ val in_proof : proof -> (Evd.evar_map -> 'a) -> 'a
    focused goals. *)
 val unshelve : proof -> proof
 
+val pr_proof : proof -> Pp.std_ppcmds
+
 (*** Compatibility layer with <=v8.2 ***)
 module V82 : sig
   val subgoals : proof -> Goal.goal list Evd.sigma
diff --git a/proofs/proof_global.ml b/proofs/proof_global.ml
index 36277bf58..120cde5e5 100644
--- a/proofs/proof_global.ml
+++ b/proofs/proof_global.ml
@@ -18,6 +18,8 @@ open Util
 open Pp
 open Names
 
+module NamedDecl = Context.Named.Declaration
+
 (*** Proof Modes ***)
 
 (* Type of proof modes :
@@ -34,7 +36,7 @@ let proof_modes = Hashtbl.create 6
 let find_proof_mode n =
   try Hashtbl.find proof_modes n
   with Not_found ->
-    Errors.error (Format.sprintf "No proof mode named \"%s\"." n)
+    CErrors.error (Format.sprintf "No proof mode named \"%s\"." n)
 
 let register_proof_mode ({name = n} as m) =
   Hashtbl.add proof_modes n (CEphemeron.create m)
@@ -88,8 +90,8 @@ type closed_proof = proof_object * proof_terminator
 type pstate = {
   pid : Id.t;
   terminator : proof_terminator CEphemeron.key;
-  endline_tactic : Tacexpr.raw_tactic_expr option;
-  section_vars : Context.section_context option;
+  endline_tactic : Genarg.glob_generic_argument option;
+  section_vars : Context.Named.t option;
   proof : Proof.proof;
   strength : Decl_kinds.goal_kind;
   mode : proof_mode CEphemeron.key;
@@ -122,15 +124,15 @@ let push a l = l := a::!l;
   update_proof_mode ()
 
 exception NoSuchProof
-let _ = Errors.register_handler begin function
-  | NoSuchProof -> Errors.error "No such proof."
-  | _ -> raise Errors.Unhandled
+let _ = CErrors.register_handler begin function
+  | NoSuchProof -> CErrors.error "No such proof."
+  | _ -> raise CErrors.Unhandled
 end
 
 exception NoCurrentProof
-let _ = Errors.register_handler begin function
-  | NoCurrentProof -> Errors.error "No focused proof (No proof-editing in progress)."
-  | _ -> raise Errors.Unhandled
+let _ = CErrors.register_handler begin function
+  | NoCurrentProof -> CErrors.error "No focused proof (No proof-editing in progress)."
+  | _ -> raise CErrors.Unhandled
 end
 
 (*** Proof Global manipulation ***)
@@ -146,9 +148,6 @@ let cur_pstate () =
 let give_me_the_proof () = (cur_pstate ()).proof
 let get_current_proof_name () = (cur_pstate ()).pid
 
-let interp_tac = ref (fun _ -> assert false)
-let set_interp_tac f = interp_tac := f
-
 let with_current_proof f =
   match !pstates with
   | [] -> raise NoCurrentProof
@@ -156,7 +155,13 @@ let with_current_proof f =
       let et =
         match p.endline_tactic with
         | None -> Proofview.tclUNIT ()
-        | Some tac -> !interp_tac tac in
+        | Some tac ->
+          let open Geninterp in
+          let ist = { lfun = Id.Map.empty; extra = TacStore.empty } in
+          let Genarg.GenArg (Genarg.Glbwit tag, tac) = tac in
+          let tac = Geninterp.interp tag ist tac in
+          Ftactic.run tac (fun _ -> Proofview.tclUNIT ())
+      in
       let (newpr,ret) = f et p.proof in
       let p = { p with proof = newpr } in
       pstates := p :: rest;
@@ -190,7 +195,7 @@ let check_no_pending_proof () =
   if not (there_are_pending_proofs ()) then
     ()
   else begin
-    Errors.error (Pp.string_of_ppcmds
+    CErrors.error (Pp.string_of_ppcmds
       (str"Proof editing in progress" ++ msg_proofs () ++ fnl() ++
        str"Use \"Abort All\" first or complete proof(s)."))
   end
@@ -202,8 +207,8 @@ let discard (loc,id) =
   let n = List.length !pstates in
   discard_gen id;
   if Int.equal (List.length !pstates) n then
-    Errors.user_err_loc
-      (loc,"Pfedit.delete_proof",str"No such proof" ++ msg_proofs ())
+    CErrors.user_err ~loc
+      ~hdr:"Pfedit.delete_proof" (str"No such proof" ++ msg_proofs ())
 
 let discard_current () =
   if List.is_empty !pstates then raise NoCurrentProof else pstates := List.tl !pstates
@@ -276,7 +281,7 @@ let set_used_variables l =
   let ids = List.fold_right Id.Set.add l Id.Set.empty in
   let ctx = Environ.keep_hyps env ids in
   let ctx_set =
-    List.fold_right Id.Set.add (List.map get_id ctx) Id.Set.empty in
+    List.fold_right Id.Set.add (List.map NamedDecl.get_id ctx) Id.Set.empty in
   let vars_of = Environ.global_vars_set in
   let aux env entry (ctx, all_safe, to_clear as orig) =
     match entry with
@@ -296,7 +301,7 @@ let set_used_variables l =
   | [] -> raise NoCurrentProof
   | p :: rest ->
       if not (Option.is_empty p.section_vars) then
-        Errors.error "Used section variables can be declared only once";
+        CErrors.error "Used section variables can be declared only once";
       pstates := { p with section_vars = Some ctx} :: rest;
       ctx, to_clear
 
@@ -312,7 +317,10 @@ let constrain_variables init uctx =
   let cstrs = UState.constrain_variables levels uctx in
   Univ.ContextSet.add_constraints cstrs (UState.context_set uctx)
 
-let close_proof ~keep_body_ucst_separate ?feedback_id ~now fpl =
+type closed_proof_output = (Term.constr * Safe_typing.private_constants) list * Evd.evar_universe_context
+
+let close_proof ~keep_body_ucst_separate ?feedback_id ~now
+                (fpl : closed_proof_output Future.computation) =
   let { pid; section_vars; strength; proof; terminator; universe_binders } =
     cur_pstate () in
   let poly = pi2 strength (* Polymorphic *) in
@@ -390,8 +398,6 @@ let close_proof ~keep_body_ucst_separate ?feedback_id ~now fpl =
     universes = (universes, binders) },
   fun pr_ending -> CEphemeron.get terminator pr_ending
 
-type closed_proof_output = (Term.constr * Safe_typing.private_constants) list * Evd.evar_universe_context
-
 let return_proof ?(allow_partial=false) () =
  let { pid; proof; strength = (_,poly,_) } = cur_pstate () in
  if allow_partial then begin
@@ -408,7 +414,7 @@ let return_proof ?(allow_partial=false) () =
   let evd =
     let error s =
       let prf = str " (in proof " ++ Id.print pid ++ str ")" in
-      raise (Errors.UserError("last tactic before Qed",s ++ prf))
+      raise (CErrors.UserError(Some "last tactic before Qed",s ++ prf))
     in
     try Proof.return proof with
     | Proof.UnfinishedProof ->
@@ -515,12 +521,12 @@ module Bullet = struct
     exception FailedBullet of t * suggestion
 
     let _ =
-      Errors.register_handler
+      CErrors.register_handler
 	(function
 	| FailedBullet (b,sugg) ->
 	  let prefix = str"Wrong bullet " ++ pr_bullet b ++ str" : " in
-	  Errors.errorlabstrm "Focus" (prefix ++ suggest_on_error sugg)
-	| _ -> raise Errors.Unhandled)
+	  CErrors.user_err ~hdr:"Focus" (prefix ++ suggest_on_error sugg)
+	| _ -> raise CErrors.Unhandled)
 
 
     (* spiwack: we need only one focus kind as we keep a stack of (distinct!) bullets *)
@@ -617,7 +623,7 @@ module Bullet = struct
     let _ = register_behavior strict
   end
 
-  (* Current bullet behavior, controled by the option *)
+  (* Current bullet behavior, controlled by the option *)
   let current_behavior = ref Strict.strict
 
   let _ =
@@ -633,7 +639,7 @@ module Bullet = struct
 	current_behavior :=
           try Hashtbl.find behaviors n
           with Not_found ->
-            Errors.error ("Unknown bullet behavior: \"" ^ n ^ "\".")
+            CErrors.error ("Unknown bullet behavior: \"" ^ n ^ "\".")
       end
     }
 
@@ -664,20 +670,26 @@ let _ =
 let default_goal_selector = ref (Vernacexpr.SelectNth 1)
 let get_default_goal_selector () = !default_goal_selector
 
+let print_range_selector (i, j) =
+  if i = j then string_of_int i
+  else string_of_int i ^ "-" ^ string_of_int j
+
 let print_goal_selector = function
   | Vernacexpr.SelectAll -> "all"
   | Vernacexpr.SelectNth i -> string_of_int i
+  | Vernacexpr.SelectList l -> "[" ^
+      String.concat ", " (List.map print_range_selector l) ^ "]"
   | Vernacexpr.SelectId id -> Id.to_string id
 
 let parse_goal_selector = function
   | "all" -> Vernacexpr.SelectAll
   | i ->
-      let err_msg = "A selector must be \"all\" or a natural number." in
+      let err_msg = "The default selector must be \"all\" or a natural number." in
       begin try
               let i = int_of_string i in
-              if i < 0 then Errors.error err_msg;
+              if i < 0 then CErrors.error err_msg;
               Vernacexpr.SelectNth i
-        with Failure _ -> Errors.error err_msg
+        with Failure _ -> CErrors.error err_msg
       end
 
 let _ =
@@ -706,7 +718,7 @@ type state = pstate list
 let freeze ~marshallable =
   match marshallable with
   | `Yes ->
-      Errors.anomaly (Pp.str"full marshalling of proof state not supported")
+      CErrors.anomaly (Pp.str"full marshalling of proof state not supported")
   | `Shallow -> !pstates
   | `No -> !pstates
 let unfreeze s = pstates := s; update_proof_mode ()
diff --git a/proofs/proof_global.mli b/proofs/proof_global.mli
index 59daa2968..97a21cf22 100644
--- a/proofs/proof_global.mli
+++ b/proofs/proof_global.mli
@@ -134,17 +134,14 @@ val simple_with_current_proof :
   (unit Proofview.tactic -> Proof.proof -> Proof.proof) -> unit
 
 (** Sets the tactic to be used when a tactic line is closed with [...] *)
-val set_endline_tactic : Tacexpr.raw_tactic_expr -> unit
-val set_interp_tac :
-  (Tacexpr.raw_tactic_expr -> unit Proofview.tactic)
-    -> unit
+val set_endline_tactic : Genarg.glob_generic_argument -> unit
 
 (** Sets the section variables assumed by the proof, returns its closure
  * (w.r.t. type dependencies and let-ins covered by it) + a list of
  * ids to be cleared *)
 val set_used_variables :
-  Names.Id.t list -> Context.section_context * (Loc.t * Names.Id.t) list
-val get_used_variables : unit -> Context.section_context option
+  Names.Id.t list -> Context.Named.t * (Loc.t * Names.Id.t) list
+val get_used_variables : unit -> Context.Named.t option
 
 val get_universe_binders : unit -> universe_binders option
 
diff --git a/proofs/proof_type.mli b/proofs/proof_type.mli
index ef0d52b62..03bc5e471 100644
--- a/proofs/proof_type.mli
+++ b/proofs/proof_type.mli
@@ -6,10 +6,11 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
+(** Legacy proof engine. Do not use in newly written code. *)
+
 open Evd
 open Names
 open Term
-open Tacexpr
 open Glob_term
 open Nametab
 open Misctypes
@@ -20,37 +21,11 @@ open Misctypes
 type prim_rule =
   | Cut of bool * bool * Id.t * types
   | Refine of constr
-  | Move of Id.t * Id.t move_location
 
 (** Nowadays, the only rules we'll consider are the primitive rules *)
 
 type rule = prim_rule
 
-(** The type [goal sigma] is the type of subgoal. It has the following form
-{v   it    = \{ evar_concl = [the conclusion of the subgoal]
-             evar_hyps = [the hypotheses of the subgoal]
-             evar_body = Evar_Empty;
-             evar_info = \{ pgm    : [The Realizer pgm if any]
-                           lc     : [Set of evar num occurring in subgoal] \}\}
-   sigma = \{ stamp = [an int chardacterizing the ed field, for quick compare]
-             ed : [A set of existential variables depending in the subgoal]
-               number of first evar,
-               it = \{ evar_concl = [the type of first evar]
-                      evar_hyps = [the context of the evar]
-                      evar_body = [the body of the Evar if any]
-                      evar_info = \{ pgm    : [Useless ??]
-                                    lc     : [Set of evars occurring
-                                              in the type of evar] \} \};
-               ...
-               number of last evar,
-               it = \{ evar_concl = [the type of evar]
-                      evar_hyps = [the context of the evar]
-                      evar_body = [the body of the Evar if any]
-                      evar_info = \{ pgm    : [Useless ??]
-                                    lc     : [Set of evars occurring
-                                              in the type of evar] \} \} \} v}
-*)
-
 type goal = Goal.goal
 
 type tactic = goal sigma -> goal list sigma
diff --git a/proofs/proof_using.ml b/proofs/proof_using.ml
index caa9b328a..a125fb10d 100644
--- a/proofs/proof_using.ml
+++ b/proofs/proof_using.ml
@@ -12,6 +12,8 @@ open Util
 open Vernacexpr
 open Context.Named.Declaration
 
+module NamedDecl = Context.Named.Declaration
+
 let to_string e =
   let rec aux = function
     | SsEmpty -> "()"
@@ -35,12 +37,14 @@ let in_nameset =
 let rec close_fwd e s =
   let s' =
     List.fold_left (fun s decl ->
-      let (id,b,ty) = Context.Named.Declaration.to_tuple decl in
-      let vb = Option.(default Id.Set.empty (map (global_vars_set e) b)) in
-      let vty = global_vars_set e ty in
+      let vb = match decl with
+               | LocalAssum _ -> Id.Set.empty
+               | LocalDef (_,b,_) -> global_vars_set e b
+      in
+      let vty = global_vars_set e (NamedDecl.get_type decl) in
       let vbty = Id.Set.union vb vty in
       if Id.Set.exists (fun v -> Id.Set.mem v s) vbty
-      then Id.Set.add id (Id.Set.union s vbty) else s)
+      then Id.Set.add (NamedDecl.get_id decl) (Id.Set.union s vbty) else s)
     s (named_context e)
     in
   if Id.Set.equal s s' then s else close_fwd e s'
@@ -63,13 +67,13 @@ and set_of_id env ty id =
         Id.Set.union (global_vars_set env ty) acc)
       Id.Set.empty ty
   else if Id.to_string id = "All" then
-    List.fold_right Id.Set.add (List.map get_id (named_context env)) Id.Set.empty
+    List.fold_right Id.Set.add (List.map NamedDecl.get_id (named_context env)) Id.Set.empty
   else if CList.mem_assoc_f Id.equal id !known_names then
     process_expr env (CList.assoc_f Id.equal id !known_names) []
   else Id.Set.singleton id
 
 and full_set env =
-  List.fold_right Id.Set.add (List.map get_id (named_context env)) Id.Set.empty
+  List.fold_right Id.Set.add (List.map NamedDecl.get_id (named_context env)) Id.Set.empty
 
 let process_expr env e ty =
   let ty_expr = SsSingl(Loc.ghost, Id.of_string "Type") in
diff --git a/proofs/proof_using.mli b/proofs/proof_using.mli
index 1bf38b690..b2c65412f 100644
--- a/proofs/proof_using.mli
+++ b/proofs/proof_using.mli
@@ -6,6 +6,8 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
+(** Utility code for section variables handling in Proof using... *)
+
 val process_expr :
   Environ.env -> Vernacexpr.section_subset_expr -> Constr.types list ->
     Names.Id.t list
diff --git a/proofs/proofs.mllib b/proofs/proofs.mllib
index 9130a186b..804a54360 100644
--- a/proofs/proofs.mllib
+++ b/proofs/proofs.mllib
@@ -2,7 +2,6 @@ Miscprint
 Goal
 Evar_refiner
 Proof_using
-Proof_errors
 Logic
 Refine
 Proof
diff --git a/proofs/redexpr.ml b/proofs/redexpr.ml
index 13b5848a3..34443b93d 100644
--- a/proofs/redexpr.ml
+++ b/proofs/redexpr.ml
@@ -7,7 +7,7 @@
 (************************************************************************)
 
 open Pp
-open Errors
+open CErrors
 open Util
 open Names
 open Term
@@ -17,7 +17,7 @@ open Genredexpr
 open Pattern
 open Reductionops
 open Tacred
-open Closure
+open CClosure
 open RedFlags
 open Libobject
 open Misctypes
@@ -29,17 +29,22 @@ let cbv_vm env sigma c =
     error "vm_compute does not support existential variables.";
   Vnorm.cbv_vm env c ctyp
 
+let warn_native_compute_disabled =
+  CWarnings.create ~name:"native-compute-disabled" ~category:"native-compiler"
+  (fun () ->
+   strbrk "native_compute disabled at configure time; falling back to vm_compute.")
+
 let cbv_native env sigma c =
   if Coq_config.no_native_compiler then
-    let () = Feedback.msg_warning (str "native_compute disabled at configure time; falling back to vm_compute.") in
-    cbv_vm env sigma c
+    (warn_native_compute_disabled ();
+     cbv_vm env sigma c)
   else
     let ctyp = Retyping.get_type_of env sigma c in
     Nativenorm.native_norm env sigma c ctyp
 
 let whd_cbn flags env sigma t =
   let (state,_) =
-    (whd_state_gen true flags env sigma (t,Reductionops.Stack.empty))
+    (whd_state_gen true true flags env sigma (t,Reductionops.Stack.empty))
   in Reductionops.Stack.zip ~refold:true state
 
 let strong_cbn flags =
@@ -68,7 +73,7 @@ let set_strategy_one ref l  =
         let cb = Global.lookup_constant sp in
 	(match cb.const_body with
 	  | OpaqueDef _ ->
-            errorlabstrm "set_transparent_const"
+            user_err ~hdr:"set_transparent_const"
               (str "Cannot make" ++ spc () ++
 		 Nametab.pr_global_env Id.Set.empty (ConstRef sp) ++
 		 spc () ++ str "transparent because it was declared opaque.");
@@ -141,7 +146,9 @@ let make_flag_constant = function
 let make_flag env 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.rMatch then red_add red fMATCH else red in
+  let red = if f.rFix then red_add red fFIX else red in
+  let red = if f.rCofix then red_add red fCOFIX 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 *)
@@ -168,19 +175,19 @@ let red_expr_tab = Summary.ref String.Map.empty ~name:"Declare Reduction"
 
 let declare_reduction s f =
   if String.Map.mem s !reduction_tab || String.Map.mem s !red_expr_tab
-  then errorlabstrm "Redexpr.declare_reduction"
+  then user_err ~hdr:"Redexpr.declare_reduction"
     (str "There is already a reduction expression of name " ++ str s)
   else reduction_tab := String.Map.add s f !reduction_tab
 
 let check_custom = function
   | ExtraRedExpr s ->
       if not (String.Map.mem s !reduction_tab || String.Map.mem s !red_expr_tab)
-      then errorlabstrm "Redexpr.check_custom" (str "Reference to undefined reduction expression " ++ str s)
+      then user_err ~hdr:"Redexpr.check_custom" (str "Reference to undefined reduction expression " ++ str s)
   |_ -> ()
 
 let decl_red_expr s e =
   if String.Map.mem s !reduction_tab || String.Map.mem s !red_expr_tab
-  then errorlabstrm "Redexpr.decl_red_expr"
+  then user_err ~hdr:"Redexpr.decl_red_expr"
     (str "There is already a reduction expression of name " ++ str s)
   else begin
     check_custom e;
@@ -209,6 +216,11 @@ let contextualize f g = function
       e_red (contextually b (l,c) (fun _ -> h))
   | None -> e_red g
 
+let warn_simpl_unfolding_modifiers =
+  CWarnings.create ~name:"simpl-unfolding-modifiers" ~category:"tactics"
+         (fun () ->
+          Pp.strbrk "The legacy simpl ignores constant unfolding modifiers.")
+
 let reduction_of_red_expr env =
   let make_flag = make_flag env in
   let rec reduction_of_red_expr = function
@@ -221,7 +233,7 @@ let reduction_of_red_expr env =
      let am = if !simplIsCbn then strong_cbn (make_flag f) else simpl in
      let () =
        if not (!simplIsCbn || List.is_empty f.rConst) then
-	 Feedback.msg_warning (Pp.strbrk "The legacy simpl does not deal with delta flags.") in
+	 warn_simpl_unfolding_modifiers () in
      (contextualize (if head_style then whd_am else am) am o,DEFAULTcast)
   | Cbv f -> (e_red (cbv_norm_flags (make_flag f)),DEFAULTcast)
   | Cbn f ->
@@ -235,7 +247,7 @@ let reduction_of_red_expr env =
       with Not_found ->
 	(try reduction_of_red_expr (String.Map.find s !red_expr_tab)
 	 with Not_found ->
-	   errorlabstrm "Redexpr.reduction_of_red_expr"
+	   user_err ~hdr:"Redexpr.reduction_of_red_expr"
              (str "unknown user-defined reduction \"" ++ str s ++ str "\"")))
   | CbvVm o -> (contextualize cbv_vm cbv_vm o, VMcast)
   | CbvNative o -> (contextualize cbv_native cbv_native o, NATIVEcast)
diff --git a/proofs/redexpr.mli b/proofs/redexpr.mli
index b91911087..d4c2c4a6c 100644
--- a/proofs/redexpr.mli
+++ b/proofs/redexpr.mli
@@ -6,6 +6,8 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
+(** Interpretation layer of redexprs such as hnf, cbv, etc. *)
+
 open Names
 open Term
 open Pattern
diff --git a/proofs/refine.ml b/proofs/refine.ml
index 76e2d7dc5..c238f731d 100644
--- a/proofs/refine.ml
+++ b/proofs/refine.ml
@@ -11,6 +11,8 @@ open Sigma.Notations
 open Proofview.Notations
 open Context.Named.Declaration
 
+module NamedDecl = Context.Named.Declaration
+
 let extract_prefix env info =
   let ctx1 = List.rev (Environ.named_context env) in
   let ctx2 = List.rev (Evd.evar_context info) in
@@ -26,7 +28,7 @@ let typecheck_evar ev env sigma =
   let info = Evd.find sigma ev in
   (** Typecheck the hypotheses. *)
   let type_hyp (sigma, env) decl =
-    let t = get_type decl in
+    let t = NamedDecl.get_type decl in
     let evdref = ref sigma in
     let _ = Typing.e_sort_of env evdref t in
     let () = match decl with
@@ -51,7 +53,25 @@ let typecheck_proof c concl env sigma =
 let (pr_constrv,pr_constr) =
   Hook.make ~default:(fun _env _sigma _c -> Pp.str"<constr>") ()
 
-let refine ?(unsafe = true) f = Proofview.Goal.enter { enter = begin fun gl ->
+(* Get the side-effect's constant declarations to update the monad's
+  * environmnent *)
+let add_if_undefined kn cb env =
+  try ignore(Environ.lookup_constant kn env); env
+  with Not_found -> Environ.add_constant kn cb env
+
+(* Add the side effects to the monad's environment, if not already done. *)
+let add_side_effect env = function
+  | { Entries.eff = Entries.SEsubproof (kn, cb, eff_env) } ->
+    add_if_undefined kn cb env
+  | { Entries.eff = Entries.SEscheme (l,_) } ->
+    List.fold_left (fun env (_,kn,cb,eff_env) ->
+        add_if_undefined kn cb env) env l
+
+let add_side_effects env effects =
+  List.fold_left (fun env eff -> add_side_effect env eff) env effects
+
+let make_refine_enter ?(unsafe = true) f =
+  { enter = fun gl ->
   let gl = Proofview.Goal.assume gl in
   let sigma = Proofview.Goal.sigma gl in
   let sigma = Sigma.to_evar_map sigma in
@@ -62,9 +82,13 @@ let refine ?(unsafe = true) f = Proofview.Goal.enter { enter = begin fun gl ->
   let prev_future_goals = Evd.future_goals sigma in
   let prev_principal_goal = Evd.principal_future_goal sigma in
   (** Create the refinement term *)
-  let (c, sigma) = Sigma.run (Evd.reset_future_goals sigma) f in
+  let ((v,c), sigma) = Sigma.run (Evd.reset_future_goals sigma) f in
   let evs = Evd.future_goals sigma in
   let evkmain = Evd.principal_future_goal sigma in
+  (** Redo the effects in sigma in the monad's env *)
+  let privates_csts = Evd.eval_side_effects sigma in
+  let sideff = Safe_typing.side_effects_of_private_constants privates_csts in
+  let env = add_side_effects env sideff in
   (** Check that the introduced evars are well-typed *)
   let fold accu ev = typecheck_evar ev env accu in
   let sigma = if unsafe then sigma else CList.fold_left fold sigma evs in
@@ -91,11 +115,20 @@ let refine ?(unsafe = true) f = Proofview.Goal.enter { enter = begin fun gl ->
   (** Select the goals *)
   let comb = CList.map_filter (Proofview.Unsafe.advance sigma) (CList.rev evs) in
   let sigma = CList.fold_left Proofview.Unsafe.mark_as_goal sigma comb in
-  let trace () = Pp.(hov 2 (str"refine"++spc()++ Hook.get pr_constrv env sigma c)) in
-  Proofview.Trace.name_tactic trace (Proofview.tclUNIT ()) >>= fun () ->
-  Proofview.Unsafe.tclEVARS sigma >>= fun () ->
-  Proofview.Unsafe.tclSETGOALS comb
-end }
+  let trace () = Pp.(hov 2 (str"simple refine"++spc()++ Hook.get pr_constrv env sigma c)) in
+  Proofview.Trace.name_tactic trace (Proofview.tclUNIT v) >>= fun v ->
+  Proofview.Unsafe.tclSETENV (Environ.reset_context env) <*>
+  Proofview.Unsafe.tclEVARS sigma <*>
+  Proofview.Unsafe.tclSETGOALS comb <*>
+  Proofview.tclUNIT v
+  }
+
+let refine_one ?(unsafe = true) f =
+  Proofview.Goal.enter_one (make_refine_enter ~unsafe f)
+
+let refine ?(unsafe = true) f =
+  let f = { run = fun sigma -> let Sigma (c,sigma,p) = f.run sigma in Sigma (((),c),sigma,p) } in
+  Proofview.Goal.enter (make_refine_enter ~unsafe f)
 
 (** Useful definitions *)
 
@@ -118,3 +151,14 @@ let refine_casted ?unsafe f = Proofview.Goal.enter { enter = begin fun gl ->
   } in
   refine ?unsafe f
 end }
+
+(** {7 solve_constraints}
+
+  Ensure no remaining unification problems are left. Run at every "." by default. *)
+
+let solve_constraints =
+  let open Proofview in
+  tclENV >>= fun env -> tclEVARMAP >>= fun sigma ->
+   try let sigma = Evarconv.solve_unif_constraints_with_heuristics env sigma in
+       Unsafe.tclEVARSADVANCE sigma
+   with e -> tclZERO e
diff --git a/proofs/refine.mli b/proofs/refine.mli
index 17c7e28ca..a44632eff 100644
--- a/proofs/refine.mli
+++ b/proofs/refine.mli
@@ -6,6 +6,11 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
+(** The primitive refine tactic used to fill the holes in partial proofs. This
+    is the recommanded way to write tactics when the proof term is easy to
+    write down. Note that this is not the user-level refine tactic defined
+    in Ltac which is actually based on the one below. *)
+
 open Proofview
 
 (** {6 The refine tactic} *)
@@ -25,6 +30,9 @@ val refine : ?unsafe:bool -> Constr.t Sigma.run -> unit tactic
     tactic failures. If [unsafe] is [false] (default is [true]) [t] is
     type-checked beforehand. *)
 
+val refine_one : ?unsafe:bool -> ('a * Constr.t) Sigma.run -> 'a tactic
+(** A generalization of [refine] which assumes exactly one goal under focus *)
+
 (** {7 Helper functions} *)
 
 val with_type : Environ.env -> Evd.evar_map ->
@@ -35,3 +43,8 @@ val with_type : Environ.env -> Evd.evar_map ->
 val refine_casted : ?unsafe:bool -> Constr.t Sigma.run -> unit tactic
 (** Like {!refine} except the refined term is coerced to the conclusion of the
     current goal. *)
+
+(** {7 Unification constraint handling} *)
+
+val solve_constraints : unit tactic
+(** Solve any remaining unification problems, applying heuristics. *)
diff --git a/proofs/refiner.ml b/proofs/refiner.ml
index 23433692c..9a0b56b84 100644
--- a/proofs/refiner.ml
+++ b/proofs/refiner.ml
@@ -7,13 +7,14 @@
 (************************************************************************)
 
 open Pp
-open Errors
+open CErrors
 open Util
 open Evd
 open Environ
 open Proof_type
 open Logic
-open Context.Named.Declaration
+
+module NamedDecl = Context.Named.Declaration
 
 let sig_it x = x.it
 let project x = x.sigma
@@ -60,7 +61,7 @@ let tclIDTAC_MESSAGE s gls =
   Feedback.msg_info (hov 0 s); tclIDTAC gls
 
 (* General failure tactic *)
-let tclFAIL_s s gls = errorlabstrm "Refiner.tclFAIL_s" (str s)
+let tclFAIL_s s gls = user_err ~hdr:"Refiner.tclFAIL_s" (str s)
 
 (* A special exception for levels for the Fail tactic *)
 exception FailError of int * std_ppcmds Lazy.t
@@ -82,7 +83,7 @@ let thens3parts_tac tacfi tac tacli (sigr,gs) =
   let nf = Array.length tacfi in
   let nl = Array.length tacli in
   let ng = List.length gs in
-  if ng<nf+nl then errorlabstrm "Refiner.thensn_tac" (str "Not enough subgoals.");
+  if ng<nf+nl then user_err ~hdr:"Refiner.thensn_tac" (str "Not enough subgoals.");
   let gll =
       (List.map_i (fun i ->
         apply_sig_tac sigr (if i<nf then tacfi.(i) else if i>=ng-nl then tacli.(nl-ng+i) else tac))
@@ -164,14 +165,14 @@ the goal unchanged *)
 let tclWEAK_PROGRESS tac ptree =
   let rslt = tac ptree in
   if Goal.V82.weak_progress rslt ptree then rslt
-  else errorlabstrm "Refiner.WEAK_PROGRESS" (str"Failed to progress.")
+  else user_err ~hdr:"Refiner.WEAK_PROGRESS" (str"Failed to progress.")
 
 (* PROGRESS tac ptree applies tac to the goal ptree and fails if tac leaves
 the goal unchanged *)
 let tclPROGRESS tac ptree =
   let rslt = tac ptree in
   if Goal.V82.progress rslt ptree then rslt
-  else errorlabstrm "Refiner.PROGRESS" (str"Failed to progress.")
+  else user_err ~hdr:"Refiner.PROGRESS" (str"Failed to progress.")
 
 (* Same as tclWEAK_PROGRESS but fails also if tactics generates several goals,
    one of them being identical to the original goal *)
@@ -182,7 +183,7 @@ let tclNOTSAMEGOAL (tac : tactic) goal =
   let rslt = tac goal in
   let {it=gls;sigma=sigma} = rslt in
   if List.exists (same_goal goal sigma) gls
-  then errorlabstrm "Refiner.tclNOTSAMEGOAL"
+  then user_err ~hdr:"Refiner.tclNOTSAMEGOAL"
       (str"Tactic generated a subgoal identical to the original goal.")
   else rslt
 
@@ -202,7 +203,7 @@ let tclSHOWHYPS (tac : tactic) (goal: Goal.goal Evd.sigma)
   let { it = gls; sigma = sigma; } = rslt in
   let hyps:Context.Named.t list =
     List.map (fun gl -> pf_hyps { it = gl; sigma=sigma; }) gls in
-  let cmp d1 d2 = Names.Id.equal (get_id d1) (get_id d2) in
+  let cmp d1 d2 = Names.Id.equal (NamedDecl.get_id d1) (NamedDecl.get_id d2) in
   let newhyps =
     List.map
       (fun hypl -> List.subtract cmp hypl oldhyps)
@@ -215,13 +216,13 @@ let tclSHOWHYPS (tac : tactic) (goal: Goal.goal Evd.sigma)
     List.fold_left
     (fun acc lh -> acc ^ (if !frst then (frst:=false;"") else " | ")
       ^ (List.fold_left
-	   (fun acc d -> (Names.Id.to_string (get_id d)) ^ " " ^ acc)
+	   (fun acc d -> (Names.Id.to_string (NamedDecl.get_id d)) ^ " " ^ acc)
 	   "" lh))
     "" newhyps in
   Feedback.msg_notice
     (str (emacs_str "<infoH>")
       ++  (hov 0 (str s))
-      ++  (str (emacs_str "</infoH>")) ++ fnl());
+      ++  (str (emacs_str "</infoH>")));
   tclIDTAC goal;;
 
 
@@ -240,8 +241,8 @@ let tclORELSE0 t1 t2 g =
   try
     t1 g
   with (* Breakpoint *)
-    | e when Errors.noncritical e ->
-      let e = Errors.push e in catch_failerror e; t2 g
+    | e when CErrors.noncritical e ->
+      let e = CErrors.push e in catch_failerror e; t2 g
 
 (* ORELSE t1 t2 tries to apply t1 and if it fails or does not progress,
    then applies t2 *)
@@ -253,8 +254,8 @@ let tclORELSE t1 t2 = tclORELSE0 (tclPROGRESS t1) t2
 let tclORELSE_THEN t1 t2then t2else gls =
   match
     try Some(tclPROGRESS t1 gls)
-    with e when Errors.noncritical e ->
-      let e = Errors.push e in catch_failerror e; None
+    with e when CErrors.noncritical e ->
+      let e = CErrors.push e in catch_failerror e; None
   with
     | None -> t2else gls
     | Some sgl ->
@@ -284,12 +285,12 @@ let ite_gen tcal tac_if continue tac_else gl=
       try
         tac_else gl
       with
-        e' when Errors.noncritical e' -> iraise e in
+        e' when CErrors.noncritical e' -> iraise e in
   try
     tcal tac_if0 continue gl
   with (* Breakpoint *)
-  | e when Errors.noncritical e ->
-    let e = Errors.push e in catch_failerror e; tac_else0 e gl
+  | e when CErrors.noncritical e ->
+    let e = CErrors.push e in catch_failerror e; tac_else0 e gl
 
 (* Try the first tactic and, if it succeeds, continue with
    the second one, and if it fails, use the third one *)
@@ -316,7 +317,7 @@ let tclSOLVE tacl = tclFIRST (List.map tclCOMPLETE tacl)
 
 let tclDO n t =
   let rec dorec k =
-    if k < 0 then errorlabstrm "Refiner.tclDO"
+    if k < 0 then user_err ~hdr:"Refiner.tclDO"
       (str"Wrong argument : Do needs a positive integer.");
     if Int.equal k 0 then tclIDTAC
     else if Int.equal k 1 then t else (tclTHEN t (dorec (k-1)))
diff --git a/proofs/refiner.mli b/proofs/refiner.mli
index dd9153a02..6dcafb77a 100644
--- a/proofs/refiner.mli
+++ b/proofs/refiner.mli
@@ -6,6 +6,8 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
+(** Legacy proof engine. Do not use in newly written code. *)
+
 open Evd
 open Proof_type
 
diff --git a/proofs/tacmach.ml b/proofs/tacmach.ml
index 8c0b4ba98..030a3cbfb 100644
--- a/proofs/tacmach.ml
+++ b/proofs/tacmach.ml
@@ -21,6 +21,8 @@ open Refiner
 open Sigma.Notations
 open Context.Named.Declaration
 
+module NamedDecl = Context.Named.Declaration
+
 let re_sig it  gc = { it = it; sigma = gc; }
 
 (**************************************************************)
@@ -46,7 +48,7 @@ let pf_hyps_types gls  =
                    | LocalDef (id,_,x) -> id, x)
            sign
 
-let pf_nth_hyp_id gls n = List.nth (pf_hyps gls) (n-1) |> get_id
+let pf_nth_hyp_id gls n = List.nth (pf_hyps gls) (n-1) |> NamedDecl.get_id
 
 let pf_last_hyp gl = List.hd (pf_hyps gl)
 
@@ -57,7 +59,7 @@ let pf_get_hyp gls id =
     raise (RefinerError (NoSuchHyp id))
 
 let pf_get_hyp_typ gls id =
-  pf_get_hyp gls id |> get_type
+  id |> pf_get_hyp gls |> NamedDecl.get_type
 
 let pf_ids_of_hyps gls = ids_of_named_context (pf_hyps gls)
 
@@ -84,7 +86,7 @@ let pf_eapply f gls x =
 let pf_reduce = pf_apply
 let pf_e_reduce = pf_apply
 
-let pf_whd_betadeltaiota         = pf_reduce whd_betadeltaiota
+let pf_whd_all         = pf_reduce whd_all
 let pf_hnf_constr                = pf_reduce hnf_constr
 let pf_nf                        = pf_reduce simpl
 let pf_nf_betaiota               = pf_reduce (fun _ -> nf_betaiota)
@@ -101,7 +103,7 @@ let pf_const_value              = pf_reduce (fun env _ -> constant_value_in env)
 let pf_reduce_to_quantified_ind = pf_reduce reduce_to_quantified_ind
 let pf_reduce_to_atomic_ind     = pf_reduce reduce_to_atomic_ind
 
-let pf_hnf_type_of gls          = pf_whd_betadeltaiota gls % pf_get_type_of gls
+let pf_hnf_type_of gls          = pf_get_type_of gls %> pf_whd_all gls
 
 let pf_is_matching              = pf_apply Constr_matching.is_matching_conv
 let pf_matches                  = pf_apply Constr_matching.matches_conv
@@ -121,15 +123,11 @@ let internal_cut_rev_no_check replace id t gl =
 let refine_no_check c gl =
   refiner (Refine c) gl
 
-let move_hyp_no_check id1 id2 gl =
-  refiner (Move (id1,id2)) gl
-
 (* Versions with consistency checks *)
 
 let internal_cut b d t = with_check (internal_cut_no_check b d t)
 let internal_cut_rev b d t = with_check (internal_cut_rev_no_check b d t)
 let refine c           = with_check (refine_no_check c)
-let move_hyp id id'  = with_check (move_hyp_no_check id id')
 
 (* Pretty-printers *)
 
@@ -175,6 +173,9 @@ module New = struct
   let pf_unsafe_type_of gl t =
     pf_apply unsafe_type_of gl t
 
+  let pf_get_type_of gl t =
+    pf_apply (Retyping.get_type_of ~lax:true) gl t
+
   let pf_type_of gl t =
     pf_apply type_of gl t
 
@@ -191,15 +192,15 @@ module New = struct
     next_ident_away id ids
 
   let pf_get_hyp id gl =
-    let hyps = Proofview.Goal.hyps gl in
+    let hyps = Proofview.Goal.env gl in
     let sign =
-      try Context.Named.lookup id hyps
+      try Environ.lookup_named id hyps
       with Not_found -> raise (RefinerError (NoSuchHyp id))
     in
     sign
 
   let pf_get_hyp_typ id gl =
-    pf_get_hyp id gl |> get_type
+    pf_get_hyp id gl |> NamedDecl.get_type
 
   let pf_hyps_types gl =
     let env = Proofview.Goal.env gl in
@@ -219,7 +220,7 @@ module New = struct
     let sigma = project gl in
     nf_evar sigma concl
 
-  let pf_whd_betadeltaiota gl t = pf_apply whd_betadeltaiota gl t
+  let pf_whd_all gl t = pf_apply whd_all gl t
 
   let pf_get_type_of gl t = pf_apply Retyping.get_type_of gl t
 
@@ -228,11 +229,11 @@ module New = struct
 
   let pf_hnf_constr gl t = pf_apply hnf_constr gl t
   let pf_hnf_type_of gl t =
-    pf_whd_betadeltaiota gl (pf_get_type_of gl t)
+    pf_whd_all gl (pf_get_type_of gl t)
 
   let pf_matches gl pat t = pf_apply Constr_matching.matches_conv gl pat t
 
-  let pf_whd_betadeltaiota gl t = pf_apply whd_betadeltaiota gl t
+  let pf_whd_all gl t = pf_apply whd_all gl t
   let pf_compute gl t = pf_apply compute gl t
 
   let pf_nf_evar gl t = nf_evar (project gl) t
diff --git a/proofs/tacmach.mli b/proofs/tacmach.mli
index 182433cb3..59f296f64 100644
--- a/proofs/tacmach.mli
+++ b/proofs/tacmach.mli
@@ -63,7 +63,7 @@ val pf_e_reduce :
   (env -> evar_map -> constr -> evar_map * constr) ->
   goal sigma -> constr -> evar_map * constr
 
-val pf_whd_betadeltaiota       : goal sigma -> constr -> constr
+val pf_whd_all       : goal sigma -> constr -> constr
 val pf_hnf_constr              : goal sigma -> constr -> constr
 val pf_nf                      : goal sigma -> constr -> constr
 val pf_nf_betaiota             : goal sigma -> constr -> constr
@@ -92,7 +92,6 @@ val refine_no_check           : constr -> tactic
 val internal_cut     : bool -> Id.t -> types -> tactic
 val internal_cut_rev : bool -> Id.t -> types -> tactic
 val refine           : constr -> tactic
-val move_hyp         : Id.t -> Id.t move_location -> tactic
 
 (** {6 Pretty-printing functions (debug only). } *)
 val pr_gls    : goal sigma -> Pp.std_ppcmds
@@ -109,7 +108,16 @@ module New : sig
   val pf_env : ('a, 'r) Proofview.Goal.t -> Environ.env
   val pf_concl : ([ `NF ], 'r) Proofview.Goal.t -> types
 
+  (** WRONG: To be avoided at all costs, it typechecks the term entirely but
+     forgets the universe constraints necessary to retypecheck it *)
   val pf_unsafe_type_of : ('a, 'r) Proofview.Goal.t -> Term.constr -> Term.types
+
+  (** This function does no type inference and expects an already well-typed term.
+      It recomputes its type in the fastest way possible (no conversion is ever involved) *)
+  val pf_get_type_of : ('a, 'r) Proofview.Goal.t -> Term.constr -> Term.types
+
+  (** This function entirely type-checks the term and computes its type
+      and the implied universe constraints. *)
   val pf_type_of : ('a, 'r) Proofview.Goal.t -> Term.constr -> evar_map * Term.types
   val pf_conv_x : ('a, 'r) Proofview.Goal.t -> Term.constr -> Term.constr -> bool
 
@@ -127,7 +135,7 @@ module New : sig
   val pf_hnf_constr : ('a, 'r) Proofview.Goal.t -> constr -> types
   val pf_hnf_type_of : ('a, 'r) Proofview.Goal.t -> constr -> types
 
-  val pf_whd_betadeltaiota : ('a, 'r) Proofview.Goal.t -> constr -> constr
+  val pf_whd_all : ('a, 'r) Proofview.Goal.t -> constr -> constr
   val pf_compute : ('a, 'r) Proofview.Goal.t -> constr -> constr
 
   val pf_matches : ('a, 'r) Proofview.Goal.t -> constr_pattern -> constr -> patvar_map
diff --git a/stm/asyncTaskQueue.ml b/stm/asyncTaskQueue.ml
index a7b381ad6..8acc3c233 100644
--- a/stm/asyncTaskQueue.ml
+++ b/stm/asyncTaskQueue.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-open Errors
+open CErrors
 open Pp
 open Util
 
@@ -170,7 +170,7 @@ module Make(T : Task) = struct
         | Unix.WSIGNALED sno -> Printf.sprintf "signalled(%d)" sno
         | Unix.WSTOPPED sno -> Printf.sprintf "stopped(%d)" sno) in
     let more_univs n =
-      CList.init 10 (fun _ ->
+      CList.init n (fun _ ->
         Universes.new_univ_level (Global.current_dirpath ())) in
 
     let rec kill_if () =
@@ -229,10 +229,8 @@ module Make(T : Task) = struct
     | (Die | TQueue.BeingDestroyed) ->
         giveback_exec_token (); kill proc; exit ()
     | Sys_error _ | Invalid_argument _ | End_of_file ->
-        giveback_exec_token ();
         T.on_task_cancellation_or_expiration_or_slave_death !last_task;
-        kill proc;
-        exit ()
+        giveback_exec_token (); kill proc; exit ()
   end
 
   module Pool = WorkerPool.Make(Model)
@@ -300,11 +298,27 @@ module Make(T : Task) = struct
   let slave_handshake () =
     Pool.worker_handshake (Option.get !slave_ic) (Option.get !slave_oc)
 
+  let pp_pid pp = 
+    (* Breaking all abstraction barriers... very nice *)
+    let get_xml pp = match Richpp.repr pp with
+      | Xml_datatype.Element("_", [], xml) -> xml
+      | _ -> assert false in
+    Richpp.richpp_of_xml (Xml_datatype.Element("_", [],
+      get_xml (Richpp.richpp_of_pp Pp.(str (System.process_id ()^ " "))) @
+      get_xml pp))
+
+  let debug_with_pid = Feedback.(function
+    | { contents = Message(Debug, loc, pp) } as fb ->
+       { fb with contents = Message(Debug,loc,pp_pid pp) }
+    | x -> x)
+
   let main_loop () =
+    (* We pass feedback to master *)
     let slave_feeder oc fb =
-      Marshal.to_channel oc (RespFeedback fb) []; flush oc in
-    Feedback.set_feeder (fun x -> slave_feeder (Option.get !slave_oc) x);
+      Marshal.to_channel oc (RespFeedback (debug_with_pid fb)) []; flush oc in
+    Feedback.add_feeder (fun x -> slave_feeder (Option.get !slave_oc) x);
     Feedback.set_logger Feedback.feedback_logger;
+    (* We ask master to allocate universe identifiers *)
     Universes.set_remote_new_univ_level (bufferize (fun () ->
       marshal_response (Option.get !slave_oc) RespGetCounterNewUnivLevel;
       match unmarshal_more_data (Option.get !slave_ic) with
@@ -343,7 +357,7 @@ module Make(T : Task) = struct
   let with_n_workers n f =
     let q = create n in 
     try let rc = f q in destroy q; rc
-    with e -> let e = Errors.push e in destroy q; iraise e
+    with e -> let e = CErrors.push e in destroy q; iraise e
 
   let n_workers { active } = Pool.n_workers active
 
diff --git a/stm/dag.ml b/stm/dag.ml
index 0c7f9f34b..99e7c9264 100644
--- a/stm/dag.ml
+++ b/stm/dag.ml
@@ -8,15 +8,6 @@
 
 module type S = sig
 
-  module Cluster :
-  sig
-    type 'd t
-    val equal : 'd t -> 'd t -> bool
-    val compare : 'd t -> 'd t -> int
-    val to_string : 'd t -> string
-    val data : 'd t -> 'd
-  end
-
   type node
   module NodeSet : Set.S with type elt = node
 
@@ -31,45 +22,57 @@ module type S = sig
   val del_nodes : ('e,'i,'d) t -> NodeSet.t  -> ('e,'i,'d) t
   val all_nodes : ('e,'i,'d) t -> NodeSet.t
 
-  val iter : ('e,'i,'d) t ->
-    (node -> 'd Cluster.t option -> 'i option ->
-      (node * 'e) list -> unit) -> unit
-
-  val create_cluster : ('e,'i,'d) t -> node list -> 'd -> ('e,'i,'d) t
-  val cluster_of : ('e,'i,'d) t -> node -> 'd Cluster.t option
-  val del_cluster : ('e,'i,'d) t -> 'd Cluster.t -> ('e,'i,'d) t
-
   val get_info : ('e,'i,'d) t -> node -> 'i option
   val set_info : ('e,'i,'d) t -> node -> 'i -> ('e,'i,'d) t
   val clear_info : ('e,'i,'d) t -> node -> ('e,'i,'d) t
 
+  module Property :
+  sig
+    type 'd t
+    val equal : 'd t -> 'd t -> bool
+    val compare : 'd t -> 'd t -> int
+    val to_string : 'd t -> string
+    val data : 'd t -> 'd
+    val having_it : 'd t -> NodeSet.t
+  end
+
+  val create_property : ('e,'i,'d) t -> node list -> 'd -> ('e,'i,'d) t
+  val property_of : ('e,'i,'d) t -> node -> 'd Property.t list
+  val del_property : ('e,'i,'d) t -> 'd Property.t -> ('e,'i,'d) t
+
+  val iter : ('e,'i,'d) t ->
+    (node -> 'd Property.t list -> 'i option ->
+      (node * 'e) list -> unit) -> unit
+
 end
 
 module Make(OT : Map.OrderedType) = struct
 
-module Cluster =
+module NodeSet = Set.Make(OT)
+
+module Property =
 struct
-  type 'd t = 'd * int
-  let equal (_,i1) (_,i2) = Int.equal i1 i2
-  let compare (_,i1) (_,i2) = Int.compare i1 i2
-  let to_string (_,i) = string_of_int i
-  let data (d,_) = d
+  type 'd t = { data : 'd; uid : int; having_it : NodeSet.t }
+  let equal { uid = i1 } { uid = i2 } = Int.equal i1 i2
+  let compare { uid = i1 } { uid = i2 } = Int.compare i1 i2
+  let to_string { uid = i } = string_of_int i
+  let data { data = d } = d
+  let having_it { having_it } = having_it
 end
 
 type node = OT.t
 
 module NodeMap = CMap.Make(OT)
-module NodeSet = Set.Make(OT)
 
 type ('edge,'info,'data) t = {
   graph : (node * 'edge) list NodeMap.t;
-  clusters : 'data Cluster.t NodeMap.t;
+  properties : 'data Property.t list NodeMap.t;
   infos : 'info NodeMap.t;
 }
 
 let empty = {
   graph = NodeMap.empty;
-  clusters = NodeMap.empty;
+  properties = NodeMap.empty;
   infos = NodeMap.empty;
 }
 
@@ -94,7 +97,7 @@ let del_edge dag id tgt = { dag with
 
 let del_nodes dag s = {
   infos = NodeMap.filter (fun n _ -> not(NodeSet.mem n s)) dag.infos;
-  clusters = NodeMap.filter (fun n _ -> not(NodeSet.mem n s)) dag.clusters;
+  properties = NodeMap.filter (fun n _ -> not(NodeSet.mem n s)) dag.properties;
   graph = NodeMap.filter (fun n l ->
       let drop = NodeSet.mem n s in
       if not drop then
@@ -102,20 +105,31 @@ let del_nodes dag s = {
       not drop)
     dag.graph }
 
+let map_add_list k v m =
+  try
+    let l = NodeMap.find k m in
+    NodeMap.add k (v::l) m
+  with Not_found -> NodeMap.add k [v] m
+
 let clid = ref 1
-let create_cluster dag l data =
+let create_property dag l data =
   incr clid;
-  { dag with clusters =
-     List.fold_right (fun x clusters ->
-       NodeMap.add x (data, !clid) clusters) l dag.clusters }
-
-let cluster_of dag id =
-  try Some (NodeMap.find id dag.clusters)
-  with Not_found -> None
-
-let del_cluster dag c =
-  { dag with clusters =
-     NodeMap.filter (fun _ c' -> not (Cluster.equal c' c)) dag.clusters }
+  let having_it = List.fold_right NodeSet.add l NodeSet.empty in
+  let property = { Property.data; uid = !clid; having_it } in
+  { dag with properties =
+     List.fold_right (fun x ps -> map_add_list x property ps) l dag.properties }
+
+let property_of dag id =
+  try NodeMap.find id dag.properties
+  with Not_found -> []
+
+let del_property dag c =
+  { dag with properties =
+     NodeMap.filter (fun _ cl -> cl <> [])
+       (NodeMap.map (fun cl ->
+          List.filter (fun c' ->
+            not (Property.equal c' c)) cl)
+          dag.properties) }
 
 let get_info dag id =
   try Some (NodeMap.find id dag.infos)
@@ -126,7 +140,7 @@ let set_info dag id info = { dag with infos = NodeMap.add id info dag.infos }
 let clear_info dag id = { dag with infos = NodeMap.remove id dag.infos }
 
 let iter dag f =
-  NodeMap.iter (fun k v -> f k (cluster_of dag k) (get_info dag k) v) dag.graph
+  NodeMap.iter (fun k v -> f k (property_of dag k) (get_info dag k) v) dag.graph
 
 let all_nodes dag = NodeMap.domain dag.graph
 
diff --git a/stm/dag.mli b/stm/dag.mli
index 6b4442df0..e783cd8ee 100644
--- a/stm/dag.mli
+++ b/stm/dag.mli
@@ -7,19 +7,7 @@
 (************************************************************************)
 
 module type S = sig
-
-  (* A cluster is just a set of nodes.  This set holds some data.
-     Stm uses this to group nodes contribution to the same proofs and
-     that can be evaluated asynchronously *)
-  module Cluster :
-  sig
-    type 'd t
-    val equal : 'd t -> 'd t -> bool
-    val compare : 'd t -> 'd t -> int
-    val to_string : 'd t -> string
-    val data : 'd t -> 'd
-  end
-
+  
   type node
   module NodeSet : Set.S with type elt = node
 
@@ -34,19 +22,35 @@ module type S = sig
   val del_nodes : ('e,'i,'d) t -> NodeSet.t  -> ('e,'i,'d) t
   val all_nodes : ('e,'i,'d) t -> NodeSet.t
 
-  val iter : ('e,'i,'d) t -> 
-    (node -> 'd Cluster.t option -> 'i option ->
-      (node * 'e) list -> unit) -> unit
-
-  val create_cluster : ('e,'i,'d) t -> node list -> 'd -> ('e,'i,'d) t
-  val cluster_of : ('e,'i,'d) t -> node -> 'd Cluster.t option
-  val del_cluster : ('e,'i,'d) t -> 'd Cluster.t -> ('e,'i,'d) t
-
   val get_info : ('e,'i,'d) t -> node -> 'i option
   val set_info : ('e,'i,'d) t -> node -> 'i -> ('e,'i,'d) t
   val clear_info : ('e,'i,'d) t -> node -> ('e,'i,'d) t
 
-end
+  (* A property applies to a set of nodes and holds some data.
+     Stm uses this feature to group nodes contributing to the same proofs and
+     to structure proofs in boxes limiting the scope of errors *)
+  module Property :
+  sig
+    type 'd t
+    val equal : 'd t -> 'd t -> bool
+    val compare : 'd t -> 'd t -> int
+    val to_string : 'd t -> string
+    val data : 'd t -> 'd
+    val having_it : 'd t -> NodeSet.t
+  end
+
+  val create_property : ('e,'i,'d) t -> node list -> 'd -> ('e,'i,'d) t
+  val property_of : ('e,'i,'d) t -> node -> 'd Property.t list
+  val del_property : ('e,'i,'d) t -> 'd Property.t -> ('e,'i,'d) t
+
+  val iter : ('e,'i,'d) t -> 
+    (node -> 'd Property.t list -> 'i option ->
+      (node * 'e) list -> unit) -> unit
+
+  end
 
-module Make(OT : Map.OrderedType) : S with type node = OT.t
+module Make(OT : Map.OrderedType) : S
+with type node = OT.t
+and type NodeSet.t = Set.Make(OT).t
+and type NodeSet.elt = OT.t
 
diff --git a/stm/proofBlockDelimiter.ml b/stm/proofBlockDelimiter.ml
new file mode 100644
index 000000000..8162fc3bb
--- /dev/null
+++ b/stm/proofBlockDelimiter.ml
@@ -0,0 +1,184 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+open Stm
+
+module Util : sig
+
+val simple_goal : Evd.evar_map -> Goal.goal -> Goal.goal list -> bool
+val is_focused_goal_simple : Stateid.t -> [ `Simple of Goal.goal list | `Not ]
+
+type 'a until = [ `Stop | `Found of static_block_declaration | `Cont of 'a ]
+
+val crawl :
+  document_view -> ?init:document_node option ->
+  ('a -> document_node -> 'a until) -> 'a ->
+    static_block_declaration option
+
+val unit_val : Stm.DynBlockData.t
+val of_bullet_val : Vernacexpr.bullet -> Stm.DynBlockData.t
+val to_bullet_val : Stm.DynBlockData.t -> Vernacexpr.bullet
+val of_vernac_expr_val : Vernacexpr.vernac_expr -> Stm.DynBlockData.t
+val to_vernac_expr_val : Stm.DynBlockData.t -> Vernacexpr.vernac_expr
+
+end = struct
+
+let unit_tag = DynBlockData.create "unit"
+let unit_val = DynBlockData.Easy.inj () unit_tag
+
+let of_bullet_val, to_bullet_val = DynBlockData.Easy.make_dyn "bullet"
+let of_vernac_expr_val, to_vernac_expr_val = DynBlockData.Easy.make_dyn "vernac_expr"
+
+let simple_goal sigma g gs =
+  let open Evar in
+  let open Evd in
+  let open Evarutil in
+  let evi = Evd.find sigma g in
+  Set.is_empty (evars_of_term evi.evar_concl) &&
+  Set.is_empty (evars_of_filtered_evar_info (nf_evar_info sigma evi)) &&
+  not (List.exists (Proofview.depends_on sigma g) gs)
+
+let is_focused_goal_simple id =
+  match state_of_id id with
+  | `Expired | `Error _ | `Valid None -> `Not
+  | `Valid (Some { proof }) ->
+       let proof = Proof_global.proof_of_state proof in
+       let focused, r1, r2, r3, sigma = Proof.proof proof in
+       let rest = List.(flatten (map (fun (x,y) -> x @ y) r1)) @ r2 @ r3 in
+       if List.for_all (fun x -> simple_goal sigma x rest) focused
+       then `Simple focused
+       else `Not
+
+type 'a until = [ `Stop | `Found of static_block_declaration | `Cont of 'a ]
+
+let crawl { entry_point; prev_node } ?(init=Some entry_point) f acc =
+  let rec crawl node acc =
+    match node with
+    | None -> None
+    | Some node ->
+        match f acc node with
+        | `Stop -> None
+        | `Found x -> Some x
+        | `Cont acc -> crawl (prev_node node) acc in
+  crawl init acc
+
+end
+
+include Util
+
+(* ****************** - foo - bar - baz *********************************** *)
+
+let static_bullet ({ entry_point; prev_node } as view) =
+  match entry_point.ast with
+  | Vernacexpr.VernacBullet b ->
+      let base = entry_point.indentation in
+      let last_tac = prev_node entry_point in
+      crawl view ~init:last_tac (fun prev node ->
+        if node.indentation < base then `Stop else
+        if node.indentation > base then `Cont node else
+        match node.ast with
+        | Vernacexpr.VernacBullet b' when b = b' ->
+          `Found { block_stop = entry_point.id; block_start = prev.id;
+                   dynamic_switch = node.id; carry_on_data = of_bullet_val b }
+        | _ -> `Stop) entry_point
+  | _ -> assert false
+
+let dynamic_bullet { dynamic_switch = id; carry_on_data = b } =
+  match is_focused_goal_simple id with
+  | `Simple focused ->
+      `ValidBlock {
+         base_state = id;
+         goals_to_admit = focused;
+         recovery_command = Some (Vernacexpr.VernacBullet (to_bullet_val b))
+      }
+  | `Not -> `Leaks
+
+let () = register_proof_block_delimiter
+  "bullet" static_bullet dynamic_bullet
+
+(* ******************** { block } ***************************************** *)
+  
+let static_curly_brace ({ entry_point; prev_node } as view) =
+  assert(entry_point.ast = Vernacexpr.VernacEndSubproof);
+  crawl view (fun (nesting,prev) node ->
+    match node.ast with
+    | Vernacexpr.VernacSubproof _ when nesting = 0 ->
+      `Found { block_stop = entry_point.id; block_start = prev.id;
+               dynamic_switch = node.id; carry_on_data = unit_val }
+    | Vernacexpr.VernacSubproof _ ->
+      `Cont (nesting - 1,node)
+    | Vernacexpr.VernacEndSubproof ->
+      `Cont (nesting + 1,node)
+    | _ -> `Cont (nesting,node)) (-1, entry_point)
+
+let dynamic_curly_brace { dynamic_switch = id } =
+  match is_focused_goal_simple id with
+  | `Simple focused ->
+      `ValidBlock {
+         base_state = id;
+         goals_to_admit = focused;
+         recovery_command = Some Vernacexpr.VernacEndSubproof
+      }
+  | `Not -> `Leaks
+
+let () = register_proof_block_delimiter
+  "curly" static_curly_brace dynamic_curly_brace
+
+(* ***************** par: ************************************************* *)
+
+let static_par { entry_point; prev_node } =
+  match prev_node entry_point with
+  | None -> None
+  | Some { id = pid } ->
+      Some { block_stop = entry_point.id; block_start = pid;
+             dynamic_switch = pid; carry_on_data = unit_val }
+
+let dynamic_par { dynamic_switch = id } =
+  match is_focused_goal_simple id with
+  | `Simple focused ->
+      `ValidBlock {
+         base_state = id;
+         goals_to_admit = focused;
+         recovery_command = None;
+      }
+  | `Not -> `Leaks
+
+let () = register_proof_block_delimiter "par" static_par dynamic_par
+
+(* ***************** simple indentation *********************************** *)
+
+let static_indent ({ entry_point; prev_node } as view) =
+   Printf.eprintf "@%d\n" (Stateid.to_int entry_point.id);
+   match prev_node entry_point with
+   | None -> None
+   | Some last_tac ->
+      if last_tac.indentation <= entry_point.indentation then None
+      else
+        crawl view ~init:(Some last_tac) (fun prev node ->
+        if node.indentation >= last_tac.indentation then `Cont node
+        else 
+          `Found { block_stop = entry_point.id; block_start = node.id;
+                   dynamic_switch = node.id;
+                   carry_on_data = of_vernac_expr_val entry_point.ast }
+        ) last_tac
+
+let dynamic_indent { dynamic_switch = id; carry_on_data = e } =
+  Printf.eprintf "%s\n" (Stateid.to_string id);
+  match is_focused_goal_simple id with
+  | `Simple [] -> `Leaks
+  | `Simple focused ->
+      let but_last = List.tl (List.rev focused) in 
+      `ValidBlock {
+         base_state = id;
+         goals_to_admit = but_last;
+         recovery_command = Some (to_vernac_expr_val e);
+      }
+  | `Not -> `Leaks
+
+let () = register_proof_block_delimiter "indent" static_indent dynamic_indent
+
diff --git a/stm/proofBlockDelimiter.mli b/stm/proofBlockDelimiter.mli
new file mode 100644
index 000000000..a55032a47
--- /dev/null
+++ b/stm/proofBlockDelimiter.mli
@@ -0,0 +1,41 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+(* This file implements proof block detection for:
+   - blocks delimited by { and }
+   - bullets with indentation
+   - par: terminator
+
+   It exports utility functions to ease the development of other proof block
+   detection code.
+*)
+
+(** A goal is simple if it nor depends on nor impacts on any other goal.
+    This function is used to detect, dynamically, if a proof block leaks,
+    i.e. if skipping it could impact other goals (like not instantiating their
+    type).  `Simple carries the list of focused goals.
+*)
+val simple_goal : Evd.evar_map -> Goal.goal -> Goal.goal list -> bool
+val is_focused_goal_simple : Stateid.t -> [ `Simple of Goal.goal list | `Not ]
+
+type 'a until = [ `Stop | `Found of Stm.static_block_declaration | `Cont of 'a ]
+
+(* Simpler function to crawl the document backward to detect the block.
+ * ?init is the entry point of the document view if not given *)
+val crawl :
+  Stm.document_view -> ?init:Stm.document_node option ->
+  ('a -> Stm.document_node -> 'a until) -> 'a ->
+    Stm.static_block_declaration option
+
+(* Dummy value for static_block_declaration when no real value is needed *)
+val unit_val : Stm.DynBlockData.t
+
+(* Bullets *)
+val of_bullet_val : Vernacexpr.bullet -> Stm.DynBlockData.t
+val to_bullet_val : Stm.DynBlockData.t -> Vernacexpr.bullet
+
diff --git a/stm/spawned.ml b/stm/spawned.ml
index 2eae6f5e2..c5bd5f6f9 100644
--- a/stm/spawned.ml
+++ b/stm/spawned.ml
@@ -46,7 +46,7 @@ let control_channel = ref None
 let channels = ref None
 
 let init_channels () =
-  if !channels <> None then Errors.anomaly(Pp.str "init_channels called twice");
+  if !channels <> None then CErrors.anomaly(Pp.str "init_channels called twice");
   let () = match !main_channel with
   | None -> ()
   | Some (Socket(mh,mpr,mpw)) ->
@@ -65,7 +65,7 @@ let init_channels () =
   | Some (Socket (ch, cpr, cpw)) ->
     controller ch cpr cpw
   | Some AnonPipe ->
-    Errors.anomaly (Pp.str "control channel cannot be a pipe")
+    CErrors.anomaly (Pp.str "control channel cannot be a pipe")
 
 let get_channels () =
   match !channels with
diff --git a/stm/stm.ml b/stm/stm.ml
index 28e749d5c..e698d1c72 100644
--- a/stm/stm.ml
+++ b/stm/stm.ml
@@ -11,8 +11,12 @@ let pr_err s = Printf.eprintf "%s] %s\n" (System.process_id ()) s; flush stderr
 let prerr_endline s = if false then begin pr_err (s ()) end else ()
 let prerr_debug s = if !Flags.debug then begin pr_err (s ()) end else ()
 
+(* Opening ppvernac below aliases Richpp, see PR#185 *)
+let pp_to_richpp  = Richpp.richpp_of_pp
+let str_to_richpp = Richpp.richpp_of_string
+
 open Vernacexpr
-open Errors
+open CErrors
 open Pp
 open Names
 open Util
@@ -20,11 +24,13 @@ open Ppvernac
 open Vernac_classifier
 open Feedback
 
+let execution_error state_id loc msg =
+    feedback ~id:(State state_id)
+      (Message (Error, Some loc, pp_to_richpp msg))
+
 module Hooks = struct
 
 let process_error, process_error_hook = Hook.make ()
-let interp, interp_hook = Hook.make ()
-let with_fail, with_fail_hook = Hook.make ()
 
 let state_computed, state_computed_hook = Hook.make
  ~default:(fun state_id ~in_cache ->
@@ -33,18 +39,16 @@ let state_computed, state_computed_hook = Hook.make
 let state_ready, state_ready_hook = Hook.make
  ~default:(fun state_id -> ()) ()
 
-let forward_feedback, forward_feedback_hook = Hook.make
- ~default:(function
+let forward_feedback, forward_feedback_hook = 
+  let m = Mutex.create () in
+  Hook.make ~default:(function
     | { id = id; route; contents } ->
-      feedback ~id:id ~route contents) ()
+        try Mutex.lock m; feedback ~id:id ~route contents; Mutex.unlock m
+        with e -> Mutex.unlock m; raise e) ()
 
 let parse_error, parse_error_hook = Hook.make
  ~default:(fun id loc msg ->
-        feedback ~id (ErrorMsg (loc, Pp.string_of_ppcmds msg))) ()
-
-let execution_error, execution_error_hook = Hook.make
- ~default:(fun state_id loc msg ->
-    feedback ~id:(State state_id) (ErrorMsg (loc, Pp.string_of_ppcmds msg))) ()
+        feedback ~id (Message(Error, Some loc, pp_to_richpp msg))) ()
 
 let unreachable_state, unreachable_state_hook = Hook.make
  ~default:(fun _ _ -> ()) ()
@@ -76,14 +80,20 @@ let interactive () =
 
 let async_proofs_workers_extra_env = ref [||]
 
-type ast = { verbose : bool; loc : Loc.t; mutable expr : vernac_expr }
-let pr_ast { expr } = pr_vernac expr
+type aast = {
+  verbose : bool;
+  loc : Loc.t;
+  indentation : int;
+  strlen : int;
+  mutable expr : vernac_expr; (* mutable: Proof using hinted by aux file *)
+}
+let pr_ast { expr; indentation } = int indentation ++ str " " ++ pr_vernac expr
 
 let default_proof_mode () = Proof_global.get_default_proof_mode_name ()
 
 (* Commands piercing opaque *)
 let may_pierce_opaque = function
-  | { expr = VernacPrint (PrintName _) } -> true
+  | { expr = VernacPrint _ } -> true
   | { expr = VernacExtend (("Extraction",_), _) } -> true
   | { expr = VernacExtend (("SeparateExtraction",_), _) } -> true
   | { expr = VernacExtend (("ExtractionLibrary",_), _) } -> true
@@ -93,40 +103,34 @@ let may_pierce_opaque = function
   | { expr = VernacExtend (("ExtractionInductive",_), _) } -> true
   | _ -> false
 
-(* Wrapper for Vernacentries.interp to set the feedback id *)
-let vernac_interp ?proof id ?route { verbose; loc; expr } =
-  let rec internal_command = function
-    | VernacResetName _ | VernacResetInitial | VernacBack _
-    | VernacBackTo _ | VernacRestart | VernacUndo _ | VernacUndoTo _
-    | VernacBacktrack _ | VernacAbortAll | VernacAbort _ -> true
-    | VernacTime (_,e) | VernacRedirect (_,(_,e)) -> internal_command e
-    | _ -> false in
-  if internal_command expr then begin
-    prerr_endline (fun () -> "ignoring " ^ Pp.string_of_ppcmds(pr_vernac expr))
-  end else begin
-    set_id_for_feedback ?route (State id);
-    Aux_file.record_in_aux_set_at loc;
-    prerr_endline (fun () -> "interpreting " ^ Pp.string_of_ppcmds(pr_vernac expr));
-    try Hooks.(call interp ?verbosely:(Some verbose) ?proof (loc, expr))
-    with e ->
-      let e = Errors.push e in
-      iraise Hooks.(call_process_error_once e)
-  end
-
 (* Wrapper for Vernac.parse_sentence to set the feedback id *)
-let vernac_parse ?newtip ?route eid s =
+let indentation_of_string s =
+  let len = String.length s in
+  let rec aux n i precise =
+    if i >= len then 0, precise, len
+    else
+      match s.[i] with
+      | ' ' | '\t' -> aux (succ n) (succ i) precise
+      | '\n' | '\r' -> aux 0 (succ i) true
+      | _ -> n, precise, len in
+  aux 0 0 false
+
+let vernac_parse ?(indlen_prev=fun() -> 0) ?newtip ?route eid s =
   let feedback_id = 
     if Option.is_empty newtip then Edit eid
     else State (Option.get newtip) in
+  let indentation, precise, strlen = indentation_of_string s in
+  let indentation =
+    if precise then indentation else indlen_prev () + indentation in
   set_id_for_feedback ?route feedback_id;
   let pa = Pcoq.Gram.parsable (Stream.of_string s) in
   Flags.with_option Flags.we_are_parsing (fun () ->
     try
       match Pcoq.Gram.entry_parse Pcoq.main_entry pa with
       | None -> raise (Invalid_argument "vernac_parse")
-      | Some ast -> ast
-    with e when Errors.noncritical e ->
-      let (e, info) = Errors.push e in
+      | Some (loc, ast) -> indentation, strlen, loc, ast
+    with e when CErrors.noncritical e ->
+      let (e, info) = CErrors.push e in
       let loc = Option.default Loc.ghost (Loc.get_loc info) in
       Hooks.(call parse_error feedback_id loc (iprint (e, info)));
       iraise (e, info))
@@ -140,7 +144,7 @@ let update_global_env () =
   if Proof_global.there_are_pending_proofs () then
     Proof_global.update_global_env ()
 
-module Vcs_ = Vcs.Make(Stateid)
+module Vcs_ = Vcs.Make(Stateid.Self)
 type future_proof = Proof_global.closed_proof_output Future.computation
 type proof_mode = string
 type depth = int
@@ -150,22 +154,27 @@ type branch_type =
   | `Proof of proof_mode * depth
   | `Edit of
       proof_mode * Stateid.t * Stateid.t  * vernac_qed_type * Vcs_.Branch.t ]
+(* TODO 8.7 : split commands and tactics, since this type is too messy now *)
 type cmd_t = {
-  ctac : bool; (* is a tactic, needed by the 8.4 semantics of Undo *)
+  ctac : bool; (* is a tactic *)
   ceff : bool; (* is a side-effecting command in the middle of a proof *)
-  cast : ast;
+  cast : aast;
   cids : Id.t list;
-  cqueue : [ `MainQueue | `TacQueue of cancel_switch | `QueryQueue of cancel_switch | `SkipQueue ] }
-type fork_t = ast * Vcs_.Branch.t * Vernacexpr.opacity_guarantee * Id.t list
+  cblock : proof_block_name option;
+  cqueue : [ `MainQueue
+           | `TacQueue of solving_tac * anon_abstracting_tac * cancel_switch
+           | `QueryQueue of cancel_switch
+           | `SkipQueue ] }
+type fork_t = aast * Vcs_.Branch.t * Vernacexpr.opacity_guarantee * Id.t list
 type qed_t = {
-  qast : ast;
+  qast : aast;
   keep : vernac_qed_type;
   mutable fproof : (future_proof * cancel_switch) option;
   brname : Vcs_.Branch.t;
   brinfo : branch_type Vcs_.branch_info
 }
-type seff_t = ast option
-type alias_t = Stateid.t * ast
+type seff_t = aast option
+type alias_t = Stateid.t * aast
 type transaction =
   | Cmd    of cmd_t
   | Fork   of fork_t
@@ -177,40 +186,69 @@ type step =
   [ `Cmd    of cmd_t
   | `Fork   of fork_t * Stateid.t option
   | `Qed    of qed_t * Stateid.t
-  | `Sideff of [ `Ast of ast * Stateid.t | `Id of Stateid.t ]
+  | `Sideff of [ `Ast of aast * Stateid.t | `Id of Stateid.t ]
   | `Alias  of alias_t ]
 type visit = { step : step; next : Stateid.t }
 
+let mkTransTac cast cblock cqueue =
+  Cmd { ctac = true; cast; cblock; cqueue; cids = []; ceff = false }
+let mkTransCmd cast cids ceff cqueue =
+  Cmd { ctac = false; cast; cblock = None; cqueue; cids; ceff }
 
 (* Parts of the system state that are morally part of the proof state *)
 let summary_pstate = [ Evarutil.meta_counter_summary_name;
                        Evd.evar_counter_summary_name;
                        "program-tcc-table" ]
-type state = {
-  system : States.state;
-  proof : Proof_global.state;
-  shallow : bool
+type cached_state =
+  | Empty
+  | Error of Exninfo.iexn
+  | Valid of state
+and state = { (* TODO: inline records in OCaml 4.03 *)
+  system : States.state;       (* summary + libstack *)
+  proof : Proof_global.state;  (* proof state *)
+  shallow : bool               (* is the state trimmed down (libstack) *)
 }
 type branch = Vcs_.Branch.t * branch_type Vcs_.branch_info
 type backup = { mine : branch; others : branch list }
-type 'vcs state_info = { (* Make private *)
-  mutable n_reached : int;
-  mutable n_goals : int;
-  mutable state : state option;
+type 'vcs state_info = { (* TODO: Make this record private to VCS *)
+  mutable n_reached : int;      (* debug cache: how many times was computed *)
+  mutable n_goals : int;        (* open goals: indentation *)
+  mutable state : cached_state; (* state value *)
   mutable vcs_backup : 'vcs option * backup option;
 }
 let default_info () =
-  { n_reached = 0; n_goals = 0; state = None; vcs_backup = None,None }
+  { n_reached = 0; n_goals = 0; state = Empty; vcs_backup = None,None }
+
+module DynBlockData : Dyn.S = Dyn.Make(struct end)
+
+(* Clusters of nodes implemented as Dag properties.  While Dag and Vcs impose
+ * no constraint on properties, here we impose boxes to be non overlapping.
+ * Such invariant makes sense for the current kinds of boxes (proof blocks and
+ * entire proofs) but may make no sense and dropped/refined in the future.
+ * Such invariant is useful to detect broken proof block detection code *)
+type box =
+  | ProofTask of pt
+  | ProofBlock of static_block_declaration * proof_block_name
+and pt = { (* TODO: inline records in OCaml 4.03 *)
+  lemma : Stateid.t;
+  qed   : Stateid.t;
+}
+and static_block_declaration = {
+  block_start : Stateid.t;
+  block_stop  : Stateid.t;
+  dynamic_switch : Stateid.t;
+  carry_on_data : DynBlockData.t;
+}
 
 (* Functions that work on a Vcs with a specific branch type *)
 module Vcs_aux : sig
 
-  val proof_nesting : (branch_type, 't,'i) Vcs_.t -> int
+  val proof_nesting : (branch_type, 't,'i,'c) Vcs_.t -> int
   val find_proof_at_depth :
-    (branch_type, 't, 'i) Vcs_.t -> int ->
+          (branch_type, 't, 'i,'c) Vcs_.t -> int ->
       Vcs_.Branch.t * branch_type Vcs_.branch_info
   exception Expired
-  val visit : (branch_type, transaction,'i) Vcs_.t -> Vcs_.Dag.node -> visit
+  val visit : (branch_type, transaction,'i,'c) Vcs_.t -> Vcs_.Dag.node -> visit
 
 end = struct (* {{{ *)
 
@@ -274,7 +312,7 @@ module VCS : sig
     pos  : id;
   }
 
-  type vcs = (branch_type, transaction, vcs state_info) Vcs_.t
+  type vcs = (branch_type, transaction, vcs state_info, box) Vcs_.t
 
   val init : id -> unit
 
@@ -288,30 +326,32 @@ module VCS : sig
   val rewrite_merge : id -> ours:transaction -> at:id -> Branch.t -> unit
   val delete_branch : Branch.t -> unit
   val commit : id -> transaction -> unit
-  val mk_branch_name : ast -> Branch.t
+  val mk_branch_name : aast -> Branch.t
   val edit_branch : Branch.t
   val branch : ?root:id -> ?pos:id -> Branch.t -> branch_type -> unit
   val reset_branch : Branch.t -> id -> unit
-  val reachable : id -> Vcs_.NodeSet.t
+  val reachable : id -> Stateid.Set.t
   val cur_tip : unit -> id
 
   val get_info : id -> vcs state_info
-  val reached : id -> bool -> unit
+  val reached : id -> unit
   val goals : id -> int -> unit
-  val set_state : id -> state -> unit
-  val get_state : id -> state option
+  val set_state : id -> cached_state -> unit
+  val get_state : id -> cached_state
 
   (* cuts from start -> stop, raising Expired if some nodes are not there *)
-  val slice : start:id -> stop:id -> vcs
-  val nodes_in_slice : start:id -> stop:id -> Stateid.t list
+  val slice : block_start:id -> block_stop:id -> vcs
+  val nodes_in_slice : block_start:id -> block_stop:id -> Stateid.t list
   
-  val create_cluster : id list -> qed:id -> start:id -> unit
-  val cluster_of : id -> (id * id) option
-  val delete_cluster_of : id -> unit
+  val create_proof_task_box : id list -> qed:id -> block_start:id -> unit
+  val create_proof_block : static_block_declaration -> string -> unit
+  val box_of : id -> box list
+  val delete_boxes_of : id -> unit
+  val proof_task_box_of : id -> pt option
 
   val proof_nesting : unit -> int
   val checkout_shallowest_proof_branch : unit -> unit
-  val propagate_sideff : replay:ast option -> unit
+  val propagate_sideff : replay:aast option -> unit
 
   val gc : unit -> unit
 
@@ -327,7 +367,6 @@ end = struct (* {{{ *)
   include Vcs_
   exception Expired = Vcs_aux.Expired
 
-  module StateidSet = Set.Make(Stateid)
   open Printf
 
   let print_dag vcs () =
@@ -345,11 +384,11 @@ end = struct (* {{{ *)
       | Qed { qast } -> string_of_ppcmds (pr_ast qast) in
     let is_green id = 
       match get_info vcs id with
-      | Some { state = Some _ } -> true
+      | Some { state = Valid _ } -> true
       | _ -> false in
     let is_red id =
       match get_info vcs id with
-      | Some s -> Int.equal s.n_reached ~-1
+      | Some { state = Error _ } -> true
       | _ -> false in
     let head = current_branch vcs in
     let heads =
@@ -369,8 +408,6 @@ end = struct (* {{{ *)
     let edge tr =
       sprintf "<<FONT POINT-SIZE=\"12\" FACE=\"sans\">%s</FONT>>"
         (quote (string_of_transaction tr)) in
-    let ids = ref StateidSet.empty in
-    let clus = Hashtbl.create 13 in
     let node_info id =
       match get_info vcs id with
       | None -> ""
@@ -383,39 +420,71 @@ end = struct (* {{{ *)
     let nodefmt oc id =
       fprintf oc "%s [label=%s,style=filled,fillcolor=%s];\n"
         (node id) (node_info id) (color id) in
-    let add_to_clus_or_ids from cf =
-      match cf with
-      | None -> ids := StateidSet.add from !ids; false
-      | Some c -> Hashtbl.replace clus c
-         (try let n = Hashtbl.find clus c in from::n
-         with Not_found -> [from]); true in
+
+    let ids = ref Stateid.Set.empty in
+    let boxes = ref [] in
+    (* Fill in *)
+    Dag.iter graph (fun from _ _ l ->
+      ids := Stateid.Set.add from !ids;
+      List.iter (fun box -> boxes := box :: !boxes)
+        (Dag.property_of graph from);
+      List.iter (fun (dest, _) ->
+        ids := Stateid.Set.add dest !ids;
+        List.iter (fun box -> boxes := box :: !boxes)
+          (Dag.property_of graph dest))
+      l);
+    boxes := CList.sort_uniquize Dag.Property.compare !boxes;
+
     let oc = open_out fname_dot in
     output_string oc "digraph states {\n";
     Dag.iter graph (fun from cf _ l ->
-      let c1 = add_to_clus_or_ids from cf in
       List.iter (fun (dest, trans) ->
-       let c2 = add_to_clus_or_ids dest (Dag.cluster_of graph dest) in
-       fprintf oc "%s -> %s [xlabel=%s,labelfloat=%b];\n"
-           (node from) (node dest) (edge trans) (c1 && c2)) l
+       fprintf oc "%s -> %s [xlabel=%s,labelfloat=true];\n"
+           (node from) (node dest) (edge trans)) l
     );
-    StateidSet.iter (nodefmt oc) !ids;
-    Hashtbl.iter (fun c nodes ->
-       fprintf oc "subgraph cluster_%s {\n" (Dag.Cluster.to_string c);
-       List.iter (nodefmt oc) nodes;
-       fprintf oc "color=blue; }\n"
-    ) clus;
+
+    let contains b1 b2 =
+      Stateid.Set.subset
+        (Dag.Property.having_it b2) (Dag.Property.having_it b1) in
+    let same_box = Dag.Property.equal in
+    let outerboxes boxes =
+       List.filter (fun b ->
+         not (List.exists (fun b1 ->
+           not (same_box b1 b) && contains b1 b) boxes)           
+         ) boxes in
+    let rec rec_print b =
+      boxes := CList.remove same_box b !boxes;
+      let sub_boxes = List.filter (contains b) (outerboxes !boxes) in
+      fprintf oc "subgraph cluster_%s {\n" (Dag.Property.to_string b);
+      List.iter rec_print sub_boxes;
+      Stateid.Set.iter (fun id ->
+        if Stateid.Set.mem id !ids then begin
+          ids := Stateid.Set.remove id !ids;
+          nodefmt oc id
+        end)
+        (Dag.Property.having_it b);
+      match Dag.Property.data b with
+      | ProofBlock ({ dynamic_switch = id }, lbl) ->
+          fprintf oc "label=\"%s (test:%s)\";\n" lbl (Stateid.to_string id);
+          fprintf oc "color=red; }\n"
+      | ProofTask _ -> fprintf oc "color=blue; }\n"
+      in
+    List.iter rec_print (outerboxes !boxes);
+    Stateid.Set.iter (nodefmt oc) !ids;
+
     List.iteri (fun i (b,id) ->
       let shape = if Branch.equal head b then "box3d" else "box" in
       fprintf oc "b%d -> %s;\n" i (node id);
       fprintf oc "b%d [shape=%s,label=\"%s\"];\n" i shape
         (Branch.to_string b);
     ) heads;
+
     output_string oc "}\n";
     close_out oc;
     ignore(Sys.command
       ("dot -Tpdf -Gcharset=latin1 " ^ fname_dot ^ " -o" ^ fname_ps))
 
-  type vcs = (branch_type, transaction, vcs state_info) t
+  type vcs = (branch_type, transaction, vcs state_info, box) t
   let vcs : vcs ref = ref (empty Stateid.dummy)
 
   let init id =
@@ -452,13 +521,12 @@ end = struct (* {{{ *)
     | Some x -> x
     | None -> raise Vcs_aux.Expired
   let set_state id s =
-    (get_info id).state <- Some s;
+    (get_info id).state <- s;
     if Flags.async_proofs_is_master () then Hooks.(call state_ready id)
   let get_state id = (get_info id).state
-  let reached id b =
+  let reached id =
     let info = get_info id in
-    if b then info.n_reached <- info.n_reached + 1
-    else info.n_reached <- -1
+    info.n_reached <- info.n_reached + 1
   let goals id n = (get_info id).n_goals <- n
   let cur_tip () = get_branch_pos (current_branch ())
 
@@ -492,57 +560,91 @@ end = struct (* {{{ *)
   
   let visit id = Vcs_aux.visit !vcs id
 
-  let nodes_in_slice ~start ~stop =
+  let nodes_in_slice ~block_start ~block_stop =
     let rec aux id =
-      if Stateid.equal id start then [] else
+      if Stateid.equal id block_start then [] else
       match visit id with
       | { next = n; step = `Cmd x } -> (id,Cmd x) :: aux n
       | { next = n; step = `Alias x } -> (id,Alias x) :: aux n
       | { next = n; step = `Sideff (`Ast (x,_)) } ->
            (id,Sideff (Some x)) :: aux n
-      | _ -> anomaly(str("Cannot slice from "^ Stateid.to_string start ^
-                         " to "^Stateid.to_string stop))
-    in aux stop
+      | _ -> anomaly(str("Cannot slice from "^ Stateid.to_string block_start ^
+                         " to "^Stateid.to_string block_stop))
+    in aux block_stop
 
-  let slice ~start ~stop =
-    let l = nodes_in_slice ~start ~stop in
+  let slice ~block_start ~block_stop =
+    let l = nodes_in_slice ~block_start ~block_stop in
     let copy_info v id =
       Vcs_.set_info v id
-        { (get_info id) with state = None; vcs_backup = None,None } in
+        { (get_info id) with state = Empty; vcs_backup = None,None } in
     let copy_info_w_state v id =
       Vcs_.set_info v id { (get_info id) with vcs_backup = None,None } in
-    let v = Vcs_.empty start in
-    let v = copy_info v start in
+    let copy_proof_blockes v =
+      let nodes = Vcs_.Dag.all_nodes (Vcs_.dag v) in
+      let props =
+        Stateid.Set.fold (fun n pl -> Vcs_.property_of !vcs n @ pl) nodes [] in
+      let props = CList.sort_uniquize Vcs_.Dag.Property.compare props in
+      List.fold_left (fun v p ->
+        Vcs_.create_property v
+          (Stateid.Set.elements (Vcs_.Dag.Property.having_it p))
+          (Vcs_.Dag.Property.data p)) v props
+    in
+    let v = Vcs_.empty block_start in
+    let v = copy_info v block_start in
     let v = List.fold_right (fun (id,tr) v ->
       let v = Vcs_.commit v id tr in
       let v = copy_info v id in
       v) l v in
     (* Stm should have reached the beginning of proof *)
-    assert (not (Option.is_empty (get_info start).state));
+    assert (match (get_info block_start).state with Valid _ -> true | _ -> false);
     (* We put in the new dag the most recent state known to master *)
     let rec fill id =
-      if (get_info id).state = None then fill (Vcs_aux.visit v id).next
-      else copy_info_w_state v id in
-    let v = fill stop in
+      match (get_info id).state with
+      | Empty | Error _ -> fill (Vcs_aux.visit v id).next
+      | Valid _ -> copy_info_w_state v id in
+    let v = fill block_stop in
     (* We put in the new dag the first state (since Qed shall run on it,
      * see check_task_aux) *)
-    copy_info_w_state v start
-
-  let nodes_in_slice ~start ~stop =
-    List.rev (List.map fst (nodes_in_slice ~start ~stop))
-
-  let create_cluster l ~qed ~start = vcs := create_cluster !vcs l (qed,start)
-  let cluster_of id = Option.map Dag.Cluster.data (cluster_of !vcs id)
-  let delete_cluster_of id =
-    Option.iter (fun x -> vcs := delete_cluster !vcs x) (Vcs_.cluster_of !vcs id)
+    let v = copy_info_w_state v block_start in
+    copy_proof_blockes v
+
+  let nodes_in_slice ~block_start ~block_stop =
+    List.rev (List.map fst (nodes_in_slice ~block_start ~block_stop))
+
+  let topo_invariant l =
+    let all = List.fold_right Stateid.Set.add l Stateid.Set.empty in
+    List.for_all
+      (fun x ->
+         let props = property_of !vcs x in
+         let sets = List.map Dag.Property.having_it props in
+         List.for_all (fun s -> Stateid.Set.(subset s all || subset all s)) sets)
+      l
+
+  let create_proof_task_box l ~qed ~block_start:lemma =
+    if not (topo_invariant l) then anomaly (str "overlapping boxes");
+    vcs := create_property !vcs l (ProofTask { qed; lemma })
+  let create_proof_block ({ block_start; block_stop} as decl) name =
+    let l = nodes_in_slice ~block_start ~block_stop in
+    if not (topo_invariant l) then anomaly (str "overlapping boxes");
+    vcs := create_property !vcs l (ProofBlock (decl, name))
+  let box_of id = List.map Dag.Property.data (property_of !vcs id)
+  let delete_boxes_of id =
+    List.iter (fun x -> vcs := delete_property !vcs x) (property_of !vcs id)
+  let proof_task_box_of id =
+    match
+      CList.map_filter (function ProofTask x -> Some x | _ -> None) (box_of id)
+    with
+    | [] -> None
+    | [x] -> Some x
+    | _ -> anomaly (str "node with more than 1 proof task box")
 
   let gc () =
     let old_vcs = !vcs in
     let new_vcs, erased_nodes = gc old_vcs in
-    Vcs_.NodeSet.iter (fun id ->
+    Stateid.Set.iter (fun id ->
         match (Vcs_aux.visit old_vcs id).step with
         | `Qed ({ fproof = Some (_, cancel_switch) }, _)
-        | `Cmd { cqueue = `TacQueue cancel_switch }
+        | `Cmd { cqueue = `TacQueue (_,_,cancel_switch) }
         | `Cmd { cqueue = `QueryQueue cancel_switch } ->
              cancel_switch := true
         | _ -> ())
@@ -596,7 +698,10 @@ end = struct (* {{{ *)
 end (* }}} *)
 
 let state_of_id id =
-  try `Valid (VCS.get_info id).state
+  try match (VCS.get_info id).state with
+    | Valid s -> `Valid (Some s)
+    | Error (e,_) -> `Error e
+    | Empty -> `Valid None
   with VCS.Expired -> `Expired
 
 
@@ -616,9 +721,10 @@ module State : sig
 
   val install_cached : Stateid.t -> unit
   val is_cached : ?cache:Summary.marshallable -> Stateid.t -> bool
+  val is_cached_and_valid : ?cache:Summary.marshallable -> Stateid.t -> bool
 
 
-  val exn_on : Stateid.t -> ?valid:Stateid.t -> iexn -> iexn
+  val exn_on : Stateid.t -> valid:Stateid.t -> iexn -> iexn
   (* to send states across worker/master *)
   type frozen_state
   val get_cached : Stateid.t -> frozen_state
@@ -661,51 +767,60 @@ end = struct (* {{{ *)
     proof,
     Summary.project_summary (States.summary_of_state system) summary_pstate
 
-  let freeze marshallable id = VCS.set_state id (freeze_global_state marshallable)
+  let freeze marshallable id =
+    VCS.set_state id (Valid (freeze_global_state marshallable))
+  let freeze_invalid id iexn = VCS.set_state id (Error iexn)
 
-  let is_cached ?(cache=`No) id =
+  let is_cached ?(cache=`No) id only_valid =
     if Stateid.equal id !cur_id then
       try match VCS.get_info id with
-        | { state = None } when cache = `Yes -> freeze `No id; true
-        | { state = None } when cache = `Shallow -> freeze `Shallow id; true
+        | { state = Empty } when cache = `Yes -> freeze `No id; true
+        | { state = Empty } when cache = `Shallow -> freeze `Shallow id; true
         | _ -> true
       with VCS.Expired -> false
     else
       try match VCS.get_info id with
-        | { state = Some _ } -> true
-        | _ -> false 
+        | { state = Empty } -> false
+        | { state = Valid _ } -> true
+        | { state = Error _ } -> not only_valid
       with VCS.Expired -> false
 
+  let is_cached_and_valid ?cache id = is_cached ?cache id true
+  let is_cached ?cache id = is_cached ?cache id false
+
   let install_cached id =
-    if Stateid.equal id !cur_id then () else (* optimization *)
-    let s =
-      match VCS.get_info id with
-      | { state = Some s } -> s
-      | _ -> anomaly (str "unfreezing a non existing state") in
-    unfreeze_global_state s; cur_id := id
+    match VCS.get_info id with
+    | { state = Valid s } ->
+         if Stateid.equal id !cur_id then () (* optimization *)
+         else begin unfreeze_global_state s; cur_id := id end
+    | { state = Error ie } -> cur_id := id; Exninfo.iraise ie 
+    | _ ->
+        (* coqc has a 1 slot cache and only for valid states *)
+        if interactive () = `No && Stateid.equal id !cur_id then ()
+        else anomaly (str "installing a non cached state")
 
   let get_cached id =
     try match VCS.get_info id with
-    | { state = Some s } -> s
+    | { state = Valid s } -> s
     | _ -> anomaly (str "not a cached state")
     with VCS.Expired -> anomaly (str "not a cached state (expired)")
 
   let assign id what =
-    if VCS.get_state id <> None then () else
+    if VCS.get_state id <> Empty then () else
     try match what with
     | `Full s ->
          let s =
            try
             let prev = (VCS.visit id).next in
-            if is_cached prev
+            if is_cached_and_valid prev
             then { s with proof = 
               Proof_global.copy_terminators
                 ~src:(get_cached prev).proof ~tgt:s.proof }
             else s
            with VCS.Expired -> s in
-         VCS.set_state id s
+         VCS.set_state id (Valid s)
     | `Proof(ontop,(pstate,counters)) ->
-         if is_cached ontop then
+         if is_cached_and_valid ontop then
            let s = get_cached ontop in
            let s = { s with proof =
              Proof_global.copy_terminators ~src:s.proof ~tgt:pstate } in
@@ -714,17 +829,17 @@ end = struct (* {{{ *)
                (Summary.surgery_summary
                  (States.summary_of_state s.system)
                counters) } in
-           VCS.set_state id s
+           VCS.set_state id (Valid s)
     with VCS.Expired -> ()
 
-  let exn_on id ?valid (e, info) =
+  let exn_on id ~valid (e, info) =
     match Stateid.get info with
     | Some _ -> (e, info)
     | None ->
         let loc = Option.default Loc.ghost (Loc.get_loc info) in
         let (e, info) = Hooks.(call_process_error_once (e, info)) in
-        Hooks.(call execution_error id loc (iprint (e, info)));
-        (e, Stateid.add info ?valid id)
+        execution_error id loc (iprint (e, info));
+        (e, Stateid.add info ~valid id)
 
   let same_env { system = s1 } { system = s2 } =
     let s1 = States.summary_of_state s1 in
@@ -753,23 +868,146 @@ end = struct (* {{{ *)
       cur_id := id;
       if feedback_processed then
         Hooks.(call state_computed id ~in_cache:false);
-      VCS.reached id true;
+      VCS.reached id;
       if Proof_global.there_are_pending_proofs () then
         VCS.goals id (Proof_global.get_open_goals ())
     with e ->
-      let (e, info) = Errors.push e in
+      let (e, info) = CErrors.push e in
       let good_id = !cur_id in
       cur_id := Stateid.dummy;
-      VCS.reached id false;
-      Hooks.(call unreachable_state id (e, info));
-      match Stateid.get info, safe_id with
-      | None, None -> iraise (exn_on id ~valid:good_id (e, info))
-      | None, Some good_id -> iraise (exn_on id ~valid:good_id (e, info))
-      | Some _, None -> iraise (e, info)
-      | Some (_,at), Some id -> iraise (e, Stateid.add info ~valid:id at)
+      VCS.reached id;
+      let ie =
+        match Stateid.get info, safe_id with
+        | None, None -> (exn_on id ~valid:good_id (e, info))
+        | None, Some good_id -> (exn_on id ~valid:good_id (e, info))
+        | Some _, None -> (e, info)
+        | Some (_,at), Some id -> (e, Stateid.add info ~valid:id at) in
+      if cache = `Yes || cache = `Shallow then freeze_invalid id ie;
+      Hooks.(call unreachable_state id ie);
+      Exninfo.iraise ie
 
 end (* }}} *)
 
+(* indentation code for Show Script, initially contributed
+ * by D. de Rauglaudre. Should be moved away.
+ *)
+
+module ShowScript = struct
+
+let indent_script_item ((ng1,ngl1),nl,beginend,ppl) (cmd,ng) =
+  (* ng1 : number of goals remaining at the current level (before cmd)
+     ngl1 : stack of previous levels with their remaining goals
+     ng : number of goals after the execution of cmd
+     beginend : special indentation stack for { } *)
+  let ngprev = List.fold_left (+) ng1 ngl1 in
+  let new_ngl =
+    if ng > ngprev then
+      (* We've branched *)
+      (ng - ngprev + 1, ng1 - 1 :: ngl1)
+    else if ng < ngprev then
+      (* A subgoal have been solved. Let's compute the new current level
+	 by discarding all levels with 0 remaining goals. *)
+      let rec loop = function
+	| (0, ng2::ngl2) -> loop (ng2,ngl2)
+	| p -> p
+      in loop (ng1-1, ngl1)
+    else
+      (* Standard case, same goal number as before *)
+      (ng1, ngl1)
+  in
+  (* When a subgoal have been solved, separate this block by an empty line *)
+  let new_nl = (ng < ngprev)
+  in
+  (* Indentation depth *)
+  let ind = List.length ngl1
+  in
+  (* Some special handling of bullets and { }, to get a nicer display *)
+  let pred n = max 0 (n-1) in
+  let ind, nl, new_beginend = match cmd with
+    | VernacSubproof _ -> pred ind, nl, (pred ind)::beginend
+    | VernacEndSubproof -> List.hd beginend, false, List.tl beginend
+    | VernacBullet _ -> pred ind, nl, beginend
+    | _ -> ind, nl, beginend
+  in
+  let pp =
+    (if nl then fnl () else mt ()) ++
+    (hov (ind+1) (str (String.make ind ' ') ++ Ppvernac.pr_vernac cmd))
+  in
+  (new_ngl, new_nl, new_beginend, pp :: ppl)
+
+let get_script prf =
+  let branch, test =
+    match prf with
+    | None -> VCS.Branch.master, fun _ -> true
+    | Some name -> VCS.current_branch (),fun nl -> nl=[] || List.mem name nl in
+  let rec find acc id =
+    if Stateid.equal id Stateid.initial ||
+       Stateid.equal id Stateid.dummy then acc else
+    let view = VCS.visit id in
+    match view.step with
+    | `Fork((_,_,_,ns), _) when test ns -> acc
+    | `Qed (qed, proof) -> find [qed.qast.expr, (VCS.get_info id).n_goals] proof
+    | `Sideff (`Ast (x,_)) ->
+         find ((x.expr, (VCS.get_info id).n_goals)::acc) view.next
+    | `Sideff (`Id id)  -> find acc id
+    | `Cmd {cast = x; ctac} when ctac -> (* skip non-tactics *)
+         find ((x.expr, (VCS.get_info id).n_goals)::acc) view.next 
+    | `Cmd _ -> find acc view.next
+    | `Alias (id,_) -> find acc id
+    | `Fork _ -> find acc view.next
+    in
+  find [] (VCS.get_branch_pos branch)
+
+let show_script ?proof () =
+  try
+    let prf =
+      try match proof with
+      | None -> Some (Pfedit.get_current_proof_name ())
+      | Some (p,_) -> Some (p.Proof_global.id)
+      with Proof_global.NoCurrentProof -> None
+    in
+    let cmds = get_script prf in
+    let _,_,_,indented_cmds =
+      List.fold_left indent_script_item ((1,[]),false,[],[]) cmds
+    in
+    let indented_cmds = List.rev (indented_cmds) in
+    msg_notice (v 0 (prlist_with_sep fnl (fun x -> x) indented_cmds))
+  with Vcs_aux.Expired -> ()
+
+end
+
+(* Wrapper for Vernacentries.interp to set the feedback id *)
+(* It is currently called 19 times, this number should be certainly
+   reduced... *)
+let stm_vernac_interp ?proof id ?route { verbose; loc; expr } =
+  (* The Stm will gain the capability to interpret commmads affecting
+     the whole document state, such as backtrack, etc... so we start
+     to design the stm command interpreter now *)
+  set_id_for_feedback ?route (State id);
+  Aux_file.record_in_aux_set_at loc;
+  (* We need to check if a command should be filtered from
+   * vernac_entries, as it cannot handle it. This should go away in
+   * future refactorings.
+   *)
+  let rec is_filtered_command = function
+  | VernacResetName _ | VernacResetInitial | VernacBack _
+  | VernacBackTo _ | VernacRestart | VernacUndo _ | VernacUndoTo _
+  | VernacBacktrack _ | VernacAbortAll | VernacAbort _ -> true
+  | VernacTime (_,e) | VernacTimeout (_,e) | VernacRedirect (_,(_,e)) -> is_filtered_command e
+  | _ -> false
+  in
+  let aux_interp cmd =
+  if is_filtered_command cmd then
+    prerr_endline (fun () -> "ignoring " ^ Pp.string_of_ppcmds(pr_vernac expr))
+  else match cmd with
+  | VernacShow ShowScript -> ShowScript.show_script ()
+  | expr ->
+    prerr_endline (fun () -> "interpreting " ^ Pp.string_of_ppcmds(pr_vernac expr));
+    try Vernacentries.interp ?verbosely:(Some verbose) ?proof (loc, expr)
+    with e ->
+      let e = CErrors.push e in
+      iraise Hooks.(call_process_error_once e)
+  in aux_interp expr
 
 (****************************** CRUFT *****************************************)
 (******************************************************************************)
@@ -842,7 +1080,7 @@ end = struct (* {{{ *)
   let back_safe () =
     let id =
       fold_until (fun n (id,_,_,_,_) ->
-        if n >= 0 && State.is_cached id then `Stop id else `Cont (succ n))
+        if n >= 0 && State.is_cached_and_valid id then `Stop id else `Cont (succ n))
         0 (VCS.get_branch_pos (VCS.current_branch ())) in
     backto id
 
@@ -852,8 +1090,6 @@ end = struct (* {{{ *)
       | VernacResetInitial ->
           VtStm (VtBack Stateid.initial, true), VtNow
       | VernacResetName (_,name) ->
-          msg_warning
-            (str"Reset not implemented for automatically generated constants");
           let id = VCS.get_branch_pos (VCS.current_branch ()) in
           (try
             let oid =
@@ -903,8 +1139,8 @@ end = struct (* {{{ *)
       | _ -> VtUnknown, VtNow
     with
     | Not_found ->
-       msg_warning(str"undo_vernac_classifier: going back to the initial state.");
-       VtStm (VtBack Stateid.initial, true), VtNow
+       CErrors.user_err ~hdr:"undo_vernac_classifier"
+        (str "Cannot undo")
 
 end (* }}} *)
 
@@ -937,10 +1173,78 @@ let record_pb_time proof_name loc time =
   end
  
 exception RemoteException of std_ppcmds
-let _ = Errors.register_handler (function
+let _ = CErrors.register_handler (function
   | RemoteException ppcmd -> ppcmd
   | _ -> raise Unhandled)
 
+(****************** proof structure for error recovery ************************)
+(******************************************************************************)
+
+type document_node = {
+  indentation : int;
+  ast : Vernacexpr.vernac_expr;
+  id : Stateid.t;
+}
+
+type document_view = {
+  entry_point : document_node;
+  prev_node : document_node -> document_node option;
+}
+
+type static_block_detection =
+  document_view -> static_block_declaration option
+
+type recovery_action = {
+  base_state : Stateid.t;
+  goals_to_admit : Goal.goal list;
+  recovery_command : Vernacexpr.vernac_expr option;
+}
+
+type dynamic_block_error_recovery =
+  static_block_declaration -> [ `ValidBlock of recovery_action | `Leaks ]
+
+let proof_block_delimiters = ref []
+
+let register_proof_block_delimiter name static dynamic =
+  if List.mem_assoc name !proof_block_delimiters then
+    CErrors.user_err ~hdr:"STM" (str "Duplicate block delimiter " ++ str name);
+  proof_block_delimiters := (name, (static,dynamic)) :: !proof_block_delimiters
+
+let mk_doc_node id = function
+  | { step = `Cmd { ctac; cast = { indentation; expr }}; next } when ctac ->
+       Some { indentation; ast = expr; id }
+  | { step = `Sideff (`Ast ({ indentation; expr }, _)); next } ->
+       Some { indentation; ast = expr; id }
+  | _ -> None
+let prev_node { id } =
+  let id = (VCS.visit id).next in
+  mk_doc_node id (VCS.visit id)
+let cur_node id = mk_doc_node id (VCS.visit id)
+
+let is_block_name_enabled name =
+  match !Flags.async_proofs_tac_error_resilience with
+  | `None -> false
+  | `All -> true
+  | `Only l -> List.mem name l
+
+let detect_proof_block id name =
+  let name = match name with None -> "indent" | Some x -> x in   
+  if is_block_name_enabled name &&
+     (Flags.async_proofs_is_master () || Flags.async_proofs_is_worker ())
+  then (
+  match cur_node id with
+  | None -> ()
+  | Some entry_point -> try
+      let static, _ = List.assoc name !proof_block_delimiters in
+      begin match static { prev_node; entry_point } with
+      | None -> ()
+      | Some ({ block_start; block_stop } as decl) ->
+          VCS.create_proof_block decl name
+      end
+    with Not_found ->
+      CErrors.user_err ~hdr:"STM"
+        (str "Unknown proof block delimiter " ++ str name)
+  )
 (****************************** THE SCHEDULER *********************************)
 (******************************************************************************)
 
@@ -1046,7 +1350,7 @@ end = struct (* {{{ *)
         try Some (ReqBuildProof ({
           Stateid.exn_info = t_exn_info;
           stop = t_stop;
-          document = VCS.slice ~start:t_start ~stop:t_stop;
+          document = VCS.slice ~block_start:t_start ~block_stop:t_stop;
           loc = t_loc;
           uuid = t_uuid;
           name = t_name }, t_drop, t_states))
@@ -1081,7 +1385,7 @@ end = struct (* {{{ *)
         let info = Stateid.add ~valid:start Exninfo.null start in
         let e = (RemoteException (strbrk s), info) in
         t_assign (`Exn e);
-        Hooks.(call execution_error start Loc.ghost (strbrk s));
+        execution_error start Loc.ghost (strbrk s);
         feedback (InProgress ~-1)
 
   let build_proof_here ~drop_pt (id,valid) loc eop =
@@ -1115,16 +1419,16 @@ end = struct (* {{{ *)
             Proof_global.close_future_proof stop (Future.from_val ~fix_exn p) in
           let terminator = (* The one sent by master is an InvalidKey *)
             Lemmas.(standard_proof_terminator [] (mk_hook (fun _ _ -> ()))) in
-          vernac_interp stop
+          stm_vernac_interp stop
             ~proof:(pobject, terminator)
-            { verbose = false; loc;
+            { verbose = false; loc; indentation = 0; strlen = 0;
               expr = (VernacEndProof (Proved (Opaque None,None))) }) in
         ignore(Future.join checked_proof);
       end;
       RespBuiltProof(proof,time)
     with
-    | e when Errors.noncritical e || e = Stack_overflow ->
-        let (e, info) = Errors.push e in
+    | e when CErrors.noncritical e || e = Stack_overflow ->
+        let (e, info) = CErrors.push e in
         (* This can happen if the proof is broken.  The error has also been
          * signalled as a feedback, hence we can silently recover *)
         let e_error_at, e_safe_id = match Stateid.get info with
@@ -1133,7 +1437,7 @@ end = struct (* {{{ *)
         let e_msg = iprint (e, info) in
         prerr_endline (fun () -> "failed with the following exception:");
         prerr_endline (fun () -> string_of_ppcmds e_msg);
-        let e_safe_states = List.filter State.is_cached my_states in
+        let e_safe_states = List.filter State.is_cached_and_valid my_states in
         RespError { e_error_at; e_safe_id; e_msg; e_safe_states }
   
   let perform_states query =
@@ -1151,19 +1455,19 @@ end = struct (* {{{ *)
       let prev =
         try
           let { next = prev; step } = VCS.visit id in
-          if State.is_cached prev && List.mem prev seen
+          if State.is_cached_and_valid prev && List.mem prev seen
           then Some (prev, State.get_cached prev, step)
           else None
         with VCS.Expired -> None in
       let this = 
-        if State.is_cached id then Some (State.get_cached id) else None in
+        if State.is_cached_and_valid id then Some (State.get_cached id) else None in
       match prev, this with
       | _, None -> None
       | Some (prev, o, `Cmd { cast = { expr }}), Some n
         when is_tac expr && State.same_env o n -> (* A pure tactic *)
           Some (id, `Proof (prev, State.proof_part_of_frozen n))
       | Some _, Some s ->
-          msg_warning (str "STM: sending back a fat state");
+          msg_debug (str "STM: sending back a fat state");
           Some (id, `Full s)
       | _, Some s -> Some (id, `Full s) in
     let rec aux seen = function
@@ -1196,7 +1500,7 @@ and Slaves : sig
   (* (eventually) remote calls *)
   val build_proof :
     loc:Loc.t -> drop_pt:bool ->
-    exn_info:(Stateid.t * Stateid.t) -> start:Stateid.t -> stop:Stateid.t ->
+    exn_info:(Stateid.t * Stateid.t) -> block_start:Stateid.t -> block_stop:Stateid.t ->
       name:string -> future_proof * cancel_switch
 
   (* blocking function that waits for the task queue to be empty *)
@@ -1234,8 +1538,8 @@ end = struct (* {{{ *)
 
   let check_task_aux extra name l i =
     let { Stateid.stop; document; loc; name = r_name }, drop = List.nth l i in
-    msg_info(
-      str(Printf.sprintf "Checking task %d (%s%s) of %s" i r_name extra name));
+    Flags.if_verbose msg_info
+      (str(Printf.sprintf "Checking task %d (%s%s) of %s" i r_name extra name));
     VCS.restore document;
     let start =
       let rec aux cur =
@@ -1257,13 +1561,13 @@ end = struct (* {{{ *)
       (* We jump at the beginning since the kernel handles side effects by also
        * looking at the ones that happen to be present in the current env *)
       Reach.known_state ~cache:`No start;
-      vernac_interp stop ~proof
-        { verbose = false; loc;
+      stm_vernac_interp stop ~proof
+        { verbose = false; loc; indentation = 0; strlen = 0;
           expr = (VernacEndProof (Proved (Opaque None,None))) };
       `OK proof
       end
     with e ->
-      let (e, info) = Errors.push e in
+      let (e, info) = CErrors.push e in
       (try match Stateid.get info with
       | None ->
           msg_error (
@@ -1355,7 +1659,7 @@ end = struct (* {{{ *)
        BuildProof { t_states = s2 } -> overlap_rel s1 s2
      | _ -> 0)
 
-  let build_proof ~loc ~drop_pt ~exn_info ~start ~stop ~name:pname =
+  let build_proof ~loc ~drop_pt ~exn_info ~block_start ~block_stop ~name:pname =
     let id, valid as t_exn_info = exn_info in
     let cancel_switch = ref false in
     if TaskQueue.n_workers (Option.get !queue) = 0 then
@@ -1364,21 +1668,21 @@ end = struct (* {{{ *)
          Future.create_delegate ~blocking:true ~name:pname (State.exn_on id ~valid) in
         let t_uuid = Future.uuid f in
         let task = ProofTask.(BuildProof {
-          t_exn_info; t_start = start; t_stop = stop; t_drop = drop_pt;
+          t_exn_info; t_start = block_start; t_stop = block_stop; t_drop = drop_pt;
           t_assign = assign; t_loc = loc; t_uuid; t_name = pname;
-          t_states = VCS.nodes_in_slice ~start ~stop }) in
+          t_states = VCS.nodes_in_slice ~block_start ~block_stop }) in
         TaskQueue.enqueue_task (Option.get !queue) (task,cancel_switch);
         f, cancel_switch
       end else
-        ProofTask.build_proof_here ~drop_pt t_exn_info loc stop, cancel_switch
+        ProofTask.build_proof_here ~drop_pt t_exn_info loc block_stop, cancel_switch
     else 
       let f, t_assign = Future.create_delegate ~name:pname (State.exn_on id ~valid) in
       let t_uuid = Future.uuid f in
       feedback (InProgress 1);
       let task = ProofTask.(BuildProof {
-        t_exn_info; t_start = start; t_stop = stop; t_assign; t_drop = drop_pt;
+        t_exn_info; t_start = block_start; t_stop = block_stop; t_assign; t_drop = drop_pt;
         t_loc = loc; t_uuid; t_name = pname;
-        t_states = VCS.nodes_in_slice ~start ~stop }) in
+        t_states = VCS.nodes_in_slice ~block_start ~block_stop }) in
       TaskQueue.enqueue_task (Option.get !queue) (task,cancel_switch);
       f, cancel_switch
 
@@ -1411,10 +1715,11 @@ and TacTask : sig
     t_state    : Stateid.t;
     t_state_fb : Stateid.t;
     t_assign   : output Future.assignement -> unit;
-    t_ast      : int * ast;
+    t_ast      : int * aast;
     t_goal     : Goal.goal;
     t_kill     : unit -> unit;
     t_name     : string }  
+  exception NoProgress
 
   include AsyncTaskQueue.Task with type task := task
 
@@ -1428,7 +1733,7 @@ end = struct (* {{{ *)
     t_state    : Stateid.t;
     t_state_fb : Stateid.t;
     t_assign   : output Future.assignement -> unit;
-    t_ast      : int * ast;
+    t_ast      : int * aast;
     t_goal     : Goal.goal;
     t_kill     : unit -> unit;
     t_name     : string }  
@@ -1437,13 +1742,15 @@ end = struct (* {{{ *)
     r_state    : Stateid.t;
     r_state_fb : Stateid.t;
     r_document : VCS.vcs option;
-    r_ast      : int * ast;
+    r_ast      : int * aast;
     r_goal     : Goal.goal;
     r_name     : string }
 
   type response =
     | RespBuiltSubProof of output
     | RespError of std_ppcmds
+    | RespNoProgress
+  exception NoProgress
 
   let name = ref "tacworker"
   let extra_env () = [||]
@@ -1457,7 +1764,7 @@ end = struct (* {{{ *)
       r_state_fb = t_state_fb;
       r_document =
         if age <> `Fresh then None
-        else Some (VCS.slice ~start:t_state ~stop:t_state);
+        else Some (VCS.slice ~block_start:t_state ~block_stop:t_state);
       r_ast      = t_ast;
       r_goal     = t_goal;
       r_name     = t_name }
@@ -1466,9 +1773,13 @@ end = struct (* {{{ *)
   let use_response _ { t_assign; t_state; t_state_fb; t_kill } resp =
     match resp with
     | RespBuiltSubProof o -> t_assign (`Val o); `Stay ((),[])
+    | RespNoProgress ->
+        let e = (NoProgress, Exninfo.null) in
+        t_assign (`Exn e);
+        t_kill ();
+        `Stay ((),[])
     | RespError msg ->
-        let info = Stateid.add ~valid:t_state Exninfo.null t_state_fb in
-        let e = (RemoteException msg, info) in
+        let e = (RemoteException msg, Exninfo.null) in
         t_assign (`Exn e);
         t_kill ();
         `Stay ((),[])
@@ -1488,7 +1799,7 @@ end = struct (* {{{ *)
     Option.iter VCS.restore vcs;
     try
       Reach.known_state ~cache:`No id;
-      let t, uc = Future.purify (fun () ->
+      Future.purify (fun () ->
        let _,_,_,_,sigma0 = Proof.proof (Proof_global.give_me_the_proof ()) in
        let g = Evd.find sigma0 r_goal in
        if not (
@@ -1496,24 +1807,22 @@ end = struct (* {{{ *)
          List.for_all (Context.Named.Declaration.for_all (Evarutil.is_ground_term sigma0))
                       Evd.(evar_context g))
        then
-         Errors.errorlabstrm "Stm" (strbrk("the par: goal selector supports ground "^
+         CErrors.user_err ~hdr:"STM" (strbrk("the par: goal selector supports ground "^
            "goals only"))
        else begin
         let (i, ast) = r_ast in
         Proof_global.simple_with_current_proof (fun _ p -> Proof.focus focus_cond () i p);
-        vernac_interp r_state_fb ast;
+        stm_vernac_interp r_state_fb ast;
         let _,_,_,_,sigma = Proof.proof (Proof_global.give_me_the_proof ()) in
         match Evd.(evar_body (find sigma r_goal)) with
-        | Evd.Evar_empty -> Errors.errorlabstrm "Stm" (str "no progress")
+        | Evd.Evar_empty -> RespNoProgress
         | Evd.Evar_defined t ->
             let t = Evarutil.nf_evar sigma t in
             if Evarutil.is_ground_term sigma t then
-              t, Evd.evar_universe_context sigma
-            else Errors.errorlabstrm "Stm" (str"The solution is not ground")
+              RespBuiltSubProof (t, Evd.evar_universe_context sigma)
+            else CErrors.user_err ~hdr:"STM" (str"The solution is not ground")
        end) ()
-     in
-       RespBuiltSubProof (t,uc)
-    with e when Errors.noncritical e -> RespError (Errors.print e)
+    with e when CErrors.noncritical e -> RespError (CErrors.print e)
 
   let name_of_task { t_name } = t_name
   let name_of_request { r_name } = r_name
@@ -1523,19 +1832,23 @@ end (* }}} *)
 and Partac : sig
 
   val vernac_interp :
-    cancel_switch -> int -> Stateid.t -> Stateid.t -> ast -> unit
+    solve:bool -> abstract:bool -> cancel_switch ->
+    int -> Stateid.t -> Stateid.t -> aast ->
+      unit
 
 end = struct (* {{{ *)
     
   module TaskQueue = AsyncTaskQueue.MakeQueue(TacTask)
 
-  let vernac_interp cancel nworkers safe_id id { verbose; loc; expr = e } =
+  let vernac_interp ~solve ~abstract cancel nworkers safe_id id
+    { indentation; verbose; loc; expr = e; strlen }
+  =
     let e, time, fail =
       let rec find time fail = function
         | VernacTime (_,e) | VernacRedirect (_,(_,e)) -> find true fail e
         | VernacFail e -> find time true e
         | _ -> e, time, fail in find false false e in
-    Hooks.call Hooks.with_fail fail (fun () ->
+    Vernacentries.with_fail fail (fun () ->
     (if time then System.with_time false else (fun x -> x)) (fun () ->
     ignore(TaskQueue.with_n_workers nworkers (fun queue ->
     Proof_global.with_current_proof (fun _ p ->
@@ -1546,50 +1859,58 @@ end = struct (* {{{ *)
           Future.create_delegate
             ~name:(Printf.sprintf "subgoal %d" i)
             (State.exn_on id ~valid:safe_id) in
-        let t_ast = (i, { verbose; loc; expr = e }) in
+        let t_ast = (i, { indentation; verbose; loc; expr = e; strlen }) in
         let t_name = Goal.uid g in
         TaskQueue.enqueue_task queue
           ({ t_state = safe_id; t_state_fb = id;
             t_assign = assign; t_ast; t_goal = g; t_name;
-            t_kill = (fun () -> TaskQueue.cancel_all queue) }, cancel);
-        Goal.uid g,f)
+            t_kill = (fun () -> if solve then TaskQueue.cancel_all queue) },
+           cancel);
+        g,f)
         1 goals in
       TaskQueue.join queue;
       let assign_tac : unit Proofview.tactic =
-        Proofview.V82.tactic (fun gl ->
-          let open Tacmach in
-          let sigma, g = project gl, sig_it gl in
-          let gid = Goal.uid g in
-          let f =
-            try List.assoc gid res
-            with Not_found -> Errors.anomaly(str"Partac: wrong focus") in
-          if Future.is_over f then
+        Proofview.(Goal.nf_enter { Goal.enter = fun g ->
+        let gid = Goal.goal g in
+        let f =
+          try List.assoc gid res
+          with Not_found -> CErrors.anomaly(str"Partac: wrong focus") in
+        if not (Future.is_over f) then
+          (* One has failed and cancelled the others, but not this one *)
+          if solve then Tacticals.New.tclZEROMSG
+            (str"Interrupted by the failure of another goal")
+          else tclUNIT ()
+        else
+          let open Notations in
+          try
             let pt, uc = Future.join f in
             prerr_endline (fun () -> string_of_ppcmds(hov 0 (
-              str"g=" ++ str gid ++ spc () ++
+              str"g=" ++ int (Evar.repr gid) ++ spc () ++
               str"t=" ++ (Printer.pr_constr pt) ++ spc () ++
               str"uc=" ++ Evd.pr_evar_universe_context uc)));
-            let sigma = Goal.V82.partial_solution sigma g pt in
-            let sigma = Evd.merge_universe_context sigma uc in
-            re_sig [] sigma
-          else (* One has failed and cancelled the others, but not this one *)
-            re_sig [g] sigma) in
+            (if abstract then Tactics.tclABSTRACT None else (fun x -> x))
+              (V82.tactic (Refiner.tclPUSHEVARUNIVCONTEXT uc) <*>
+              Tactics.exact_no_check pt)
+          with TacTask.NoProgress ->
+            if solve then Tacticals.New.tclSOLVE [] else tclUNIT ()
+        })
+      in
       Proof.run_tactic (Global.env()) assign_tac p)))) ())
   
 end (* }}} *)
 
 and QueryTask : sig
 
-  type task = { t_where : Stateid.t; t_for : Stateid.t ; t_what : ast }
+  type task = { t_where : Stateid.t; t_for : Stateid.t ; t_what : aast }
   include AsyncTaskQueue.Task with type task := task
 
 end = struct (* {{{ *)
   
   type task =
-    { t_where : Stateid.t; t_for : Stateid.t ; t_what : ast }
+    { t_where : Stateid.t; t_for : Stateid.t ; t_what : aast }
   
   type request =
-    { r_where : Stateid.t ; r_for : Stateid.t ; r_what : ast; r_doc : VCS.vcs }
+    { r_where : Stateid.t ; r_for : Stateid.t ; r_what : aast; r_doc : VCS.vcs }
   type response = unit
 
   let name = ref "queryworker"
@@ -1601,7 +1922,7 @@ end = struct (* {{{ *)
     try Some {
       r_where = t_where;
       r_for   = t_for;
-      r_doc   = VCS.slice ~start:t_where ~stop:t_where;
+      r_doc   = VCS.slice ~block_start:t_where ~block_stop:t_where;
       r_what  = t_what }
     with VCS.Expired -> None
   
@@ -1620,12 +1941,12 @@ end = struct (* {{{ *)
     VCS.print ();
     Reach.known_state ~cache:`No r_where;
     try
-      vernac_interp r_for { r_what with verbose = true };
+      stm_vernac_interp r_for { r_what with verbose = true };
       feedback ~id:(State r_for) Processed
-    with e when Errors.noncritical e ->
-      let e = Errors.push e in
-      let msg = string_of_ppcmds (iprint e) in
-      feedback ~id:(State r_for) (ErrorMsg (Loc.ghost, msg))
+    with e when CErrors.noncritical e ->
+      let e = CErrors.push e in
+      let msg = pp_to_richpp (iprint e) in
+      feedback ~id:(State r_for) (Message (Error, None, msg))
     
   let name_of_task { t_what } = string_of_ppcmds (pr_ast t_what)
   let name_of_request { r_what } = string_of_ppcmds (pr_ast r_what)
@@ -1635,7 +1956,7 @@ end (* }}} *)
 and Query : sig 
 
   val init : unit -> unit
-  val vernac_interp : cancel_switch -> Stateid.t ->  Stateid.t -> ast -> unit
+  val vernac_interp : cancel_switch -> Stateid.t ->  Stateid.t -> aast -> unit
 
 end = struct (* {{{ *)
 
@@ -1672,10 +1993,16 @@ let async_policy () =
     (!compilation_mode = BuildVio || !async_proofs_mode <> APoff)
 
 let delegate name =
-  let time = get_hint_bp_time name in
-  time >= 1.0 || !Flags.compilation_mode = Flags.BuildVio
-              || !Flags.async_proofs_full
+     get_hint_bp_time name >= !Flags.async_proofs_delegation_threshold
+  || !Flags.compilation_mode = Flags.BuildVio
+  || !Flags.async_proofs_full
  
+let warn_deprecated_nested_proofs =
+  CWarnings.create ~name:"deprecated-nested-proofs" ~category:"deprecated"
+         (fun () ->
+          strbrk ("Nested proofs are deprecated and will "^
+                    "stop working in a future Coq version"))
+
 let collect_proof keep cur hd brkind id =
  prerr_endline (fun () -> "Collecting proof ending at "^Stateid.to_string id);
  let no_name = "" in
@@ -1724,7 +2051,7 @@ let collect_proof keep cur hd brkind id =
         let name = name ids in
         `ASync (parent last,proof_using_ast last,accn,name,delegate name)
     | `Fork((_, hd', GuaranteesOpacity, ids), _) when
-       has_proof_no_using last && not (State.is_cached (parent last)) &&
+       has_proof_no_using last && not (State.is_cached_and_valid (parent last)) &&
        !Flags.compilation_mode = Flags.BuildVio ->
         assert (VCS.Branch.equal hd hd'||VCS.Branch.equal hd VCS.edit_branch);
         (try
@@ -1740,8 +2067,7 @@ let collect_proof keep cur hd brkind id =
         let name = name ids in
         `MaybeASync (parent last, None, accn, name, delegate name)
     | `Sideff _ ->
-        Pp.(msg_warning (strbrk ("Nested proofs are deprecated and will "^
-           "stop working in the next Coq version")));
+       warn_deprecated_nested_proofs ();
         `Sync (no_name,None,`NestedProof)
     | _ -> `Sync (no_name,None,`Unknown) in
  let make_sync why = function
@@ -1760,7 +2086,7 @@ let collect_proof keep cur hd brkind id =
        let rc = collect (Some cur) [] id in
        if is_empty rc then make_sync `AlreadyEvaluated rc
        else if (keep == VtKeep || keep == VtKeepAsAxiom) &&
-          (not(State.is_cached id) || !Flags.async_proofs_full)
+          (not(State.is_cached_and_valid id) || !Flags.async_proofs_full)
        then check_policy rc
        else make_sync `AlreadyEvaluated rc
 
@@ -1790,6 +2116,71 @@ let log_processing_sync id name reason = log_string Printf.(sprintf
 let wall_clock_last_fork = ref 0.0
 
 let known_state ?(redefine_qed=false) ~cache id =
+ 
+  let error_absorbing_tactic id blockname exn =
+    (* We keep the static/dynamic part of block detection separate, since
+       the static part could be performed earlier.  As of today there is
+       no advantage in doing so since no UI can exploit such piece of info *)
+    detect_proof_block id blockname;
+
+    let boxes = VCS.box_of id in
+    let valid_boxes = CList.map_filter (function
+      | ProofBlock ({ block_stop } as decl, name) when Stateid.equal block_stop id ->
+          Some (decl, name)
+      | _ -> None) boxes in
+    assert(List.length valid_boxes < 2);
+    if valid_boxes = [] then iraise exn
+    else
+      let decl, name = List.hd valid_boxes in
+      try
+        let _, dynamic_check = List.assoc name !proof_block_delimiters in
+        match dynamic_check decl with
+        | `Leaks -> iraise exn
+        | `ValidBlock { base_state; goals_to_admit; recovery_command } -> begin
+           let tac =
+             let open Proofview.Notations in
+             Proofview.Goal.nf_enter { enter = fun gl ->
+               if CList.mem_f Evar.equal
+                 (Proofview.Goal.goal gl) goals_to_admit then
+             Proofview.give_up else Proofview.tclUNIT ()
+               } in
+           match (VCS.get_info base_state).state with
+           | Valid { proof } ->
+               Proof_global.unfreeze proof;
+               Proof_global.with_current_proof (fun _ p ->
+                 feedback ~id:(State id) Feedback.AddedAxiom;
+                 fst (Pfedit.solve Vernacexpr.SelectAll None tac p), ());
+               Option.iter (fun expr -> stm_vernac_interp id {
+                  verbose = true; loc = Loc.ghost; expr; indentation = 0;
+                  strlen = 0 })
+               recovery_command
+           | _ -> assert false
+        end
+      with Not_found ->
+          CErrors.user_err ~hdr:"STM"
+            (str "Unknown proof block delimiter " ++ str name)
+  in
+
+  (* Absorb tactic errors from f () *)
+  let resilient_tactic id blockname f =
+    if !Flags.async_proofs_tac_error_resilience = `None ||
+       (Flags.async_proofs_is_master () &&
+        !Flags.async_proofs_mode = Flags.APoff)
+    then f ()
+    else
+      try f ()
+      with e when CErrors.noncritical e ->
+        let ie = CErrors.push e in
+        error_absorbing_tactic id blockname ie in
+  (* Absorb errors from f x *)
+  let resilient_command f x =
+    if not !Flags.async_proofs_cmd_error_resilience ||
+       (Flags.async_proofs_is_master () &&
+        !Flags.async_proofs_mode = Flags.APoff)
+    then f x
+    else
+      try f x
+      with e when CErrors.noncritical e -> () in
 
   (* ugly functions to process nested lemmas, i.e. hard to reproduce
    * side effects *)
@@ -1799,18 +2190,18 @@ let known_state ?(redefine_qed=false) ~cache id =
   let inject_non_pstate (s,l) =
     Summary.unfreeze_summary s; Lib.unfreeze l; update_global_env ()
   in
-  let rec pure_cherry_pick_non_pstate id = Future.purify (fun id ->
+  let rec pure_cherry_pick_non_pstate safe_id id = Future.purify (fun id ->
     prerr_endline (fun () -> "cherry-pick non pstate " ^ Stateid.to_string id);
-    reach id;
+    reach ~safe_id id;
     cherry_pick_non_pstate ()) id
 
   (* traverses the dag backward from nodes being already calculated *)
-  and reach ?(redefine_qed=false) ?(cache=cache) id =
+  and reach ?safe_id ?(redefine_qed=false) ?(cache=cache) id =
     prerr_endline (fun () -> "reaching: " ^ Stateid.to_string id);
     if not redefine_qed && State.is_cached ~cache id then begin
-      State.install_cached id;
       Hooks.(call state_computed id ~in_cache:true);
-      prerr_endline (fun () -> "reached (cache)")
+      prerr_endline (fun () -> "reached (cache)");
+      State.install_cached id
     end else
     let step, cache_step, feedback_processed =
       let view = VCS.visit id in
@@ -1820,46 +2211,56 @@ let known_state ?(redefine_qed=false) ~cache id =
           ), cache, true
       | `Cmd { cast = x; cqueue = `SkipQueue } -> (fun () ->
             reach view.next), cache, true
-      | `Cmd { cast = x; cqueue = `TacQueue cancel } -> (fun () ->
-            reach ~cache:`Shallow view.next;
-            Hooks.(call tactic_being_run true); 
-            Partac.vernac_interp
-              cancel !Flags.async_proofs_n_tacworkers view.next id x;
-            Hooks.(call tactic_being_run false)
+      | `Cmd { cast = x; cqueue = `TacQueue (solve,abstract,cancel); cblock } ->
+          (fun () ->
+            resilient_tactic id cblock (fun () ->
+              reach ~cache:`Shallow view.next;
+              Hooks.(call tactic_being_run true); 
+              Partac.vernac_interp ~solve ~abstract
+                cancel !Flags.async_proofs_n_tacworkers view.next id x;
+              Hooks.(call tactic_being_run false))
           ), cache, true
       | `Cmd { cast = x; cqueue = `QueryQueue cancel }
         when Flags.async_proofs_is_master () -> (fun () ->
             reach view.next;
             Query.vernac_interp cancel view.next id x
           ), cache, false
-      | `Cmd { cast = x; ceff = eff; ctac } -> (fun () ->
-            reach view.next;
-            if ctac then Hooks.(call tactic_being_run true); 
-            vernac_interp id x;
-            if ctac then Hooks.(call tactic_being_run false); 
-	    if eff then update_global_env ()), (if eff then `Yes else cache), true
+      | `Cmd { cast = x; ceff = eff; ctac = true; cblock } -> (fun () ->
+            resilient_tactic id cblock (fun () ->
+              reach view.next;
+              Hooks.(call tactic_being_run true); 
+              stm_vernac_interp id x;
+              Hooks.(call tactic_being_run false)); 
+	    if eff then update_global_env ()
+          ), (if eff then `Yes else cache), true
+      | `Cmd { cast = x; ceff = eff } -> (fun () ->
+            resilient_command reach view.next;
+            stm_vernac_interp id x;
+	    if eff then update_global_env ()
+          ), (if eff then `Yes else cache), true
       | `Fork ((x,_,_,_), None) -> (fun () ->
-            reach view.next; vernac_interp id x;
+            resilient_command reach view.next;
+            stm_vernac_interp id x;
             wall_clock_last_fork := Unix.gettimeofday ()
           ), `Yes, true
-      | `Fork ((x,_,_,_), Some prev) -> (fun () ->
+      | `Fork ((x,_,_,_), Some prev) -> (fun () -> (* nested proof *)
             reach ~cache:`Shallow prev;
             reach view.next;
-            (try vernac_interp id x;
-            with e when Errors.noncritical e ->
-              let (e, info) = Errors.push e in
+            (try stm_vernac_interp id x;
+            with e when CErrors.noncritical e ->
+              let (e, info) = CErrors.push e in
               let info = Stateid.add info ~valid:prev id in
               iraise (e, info));
             wall_clock_last_fork := Unix.gettimeofday ()
           ), `Yes, true
       | `Qed ({ qast = x; keep; brinfo; brname } as qed, eop) ->
           let rec aux = function
-          | `ASync (start, pua, nodes, name, delegate) -> (fun () ->
+          | `ASync (block_start, pua, nodes, name, delegate) -> (fun () ->
                 assert(keep == VtKeep || keep == VtKeepAsAxiom);
                 let drop_pt = keep == VtKeepAsAxiom in
-                let stop, exn_info, loc = eop, (id, eop), x.loc in
+                let block_stop, exn_info, loc = eop, (id, eop), x.loc in
                 log_processing_async id name;
-                VCS.create_cluster nodes ~qed:id ~start;
+                VCS.create_proof_task_box nodes ~qed:id ~block_start;
                 begin match brinfo, qed.fproof with
                 | { VCS.kind = `Edit _ }, None -> assert false
                 | { VCS.kind = `Edit (_,_,_, okeep, _) }, Some (ofp, cancel) ->
@@ -1873,33 +2274,36 @@ let known_state ?(redefine_qed=false) ~cache id =
                         ^"the proof's statement to avoid that."));
                     let fp, cancel =
                       Slaves.build_proof
-                        ~loc ~drop_pt ~exn_info ~start ~stop ~name in
+                        ~loc ~drop_pt ~exn_info ~block_start ~block_stop ~name in
                     Future.replace ofp fp;
-                    qed.fproof <- Some (fp, cancel)
+                    qed.fproof <- Some (fp, cancel);
+                    (* We don't generate a new state, but we still need
+                     * to install the right one *)
+                    State.install_cached id
                 | { VCS.kind = `Proof _ }, Some _ -> assert false
                 | { VCS.kind = `Proof _ }, None ->
-                    reach ~cache:`Shallow start;
+                    reach ~cache:`Shallow block_start;
                     let fp, cancel =
                       if delegate then
                         Slaves.build_proof
-                          ~loc ~drop_pt ~exn_info ~start ~stop ~name
+                          ~loc ~drop_pt ~exn_info ~block_start ~block_stop ~name
                       else
                         ProofTask.build_proof_here
-                          ~drop_pt exn_info loc stop, ref false
+                          ~drop_pt exn_info loc block_stop, ref false
                     in
                     qed.fproof <- Some (fp, cancel);
                     let proof =
                       Proof_global.close_future_proof ~feedback_id:id fp in
                     if not delegate then ignore(Future.compute fp);
                     reach view.next;
-                    vernac_interp id ~proof x;
+                    stm_vernac_interp id ~proof x;
                     feedback ~id:(State id) Incomplete
                 | { VCS.kind = `Master }, _ -> assert false
                 end;
                 Proof_global.discard_all ()
               ), (if redefine_qed then `No else `Yes), true
           | `Sync (name, _, `Immediate) -> (fun () -> 
-                reach eop; vernac_interp id x; Proof_global.discard_all ()
+                reach eop; stm_vernac_interp id x; Proof_global.discard_all ()
               ), `Yes, true
           | `Sync (name, pua, reason) -> (fun () ->
                 log_processing_sync id name reason;
@@ -1920,7 +2324,7 @@ let known_state ?(redefine_qed=false) ~cache id =
                 if keep != VtKeepAsAxiom then
                   reach view.next;
                 let wall_clock2 = Unix.gettimeofday () in
-                vernac_interp id ?proof x;
+                stm_vernac_interp id ?proof x;
                 let wall_clock3 = Unix.gettimeofday () in
                 Aux_file.record_in_aux_at x.loc "proof_check_time"
                   (Printf.sprintf "%.3f" (wall_clock3 -. wall_clock2));
@@ -1936,17 +2340,17 @@ let known_state ?(redefine_qed=false) ~cache id =
           in
           aux (collect_proof keep (view.next, x) brname brinfo eop)
       | `Sideff (`Ast (x,_)) -> (fun () ->
-            reach view.next; vernac_interp id x; update_global_env ()
+            reach view.next; stm_vernac_interp id x; update_global_env ()
           ), cache, true
       | `Sideff (`Id origin) -> (fun () ->
             reach view.next;
-            inject_non_pstate (pure_cherry_pick_non_pstate origin);
+            inject_non_pstate (pure_cherry_pick_non_pstate view.next origin);
           ), cache, true
     in
     let cache_step =
       if !Flags.async_proofs_cache = Some Flags.Force then `Yes
       else cache_step in
-    State.define
+    State.define ?safe_id
       ~cache:cache_step ~redefine:redefine_qed ~feedback_processed step id;
     prerr_endline (fun () -> "reached: "^ Stateid.to_string id) in
   reach ~redefine_qed id
@@ -1982,7 +2386,7 @@ let observe id =
     Reach.known_state ~cache:(interactive ()) id;
     VCS.print ()
   with e ->
-    let e = Errors.push e in
+    let e = CErrors.push e in
     VCS.print ();
     VCS.restore vcs;
     iraise e
@@ -2032,7 +2436,7 @@ let check_task name (tasks,rcbackup) i =
     let rc = Future.purify (Slaves.check_task name tasks) i in
     VCS.restore vcs;
     rc
-  with e when Errors.noncritical e -> VCS.restore vcs; false
+  with e when CErrors.noncritical e -> VCS.restore vcs; false
 let info_tasks (tasks,_) = Slaves.info_tasks tasks
 let finish_tasks name u d p (t,rcbackup as tasks) =
   RemoteCounter.restore rcbackup;
@@ -2045,11 +2449,11 @@ let finish_tasks name u d p (t,rcbackup as tasks) =
     let u, a, _ = List.fold_left finish_task u (info_tasks tasks) in
     (u,a,true), p
   with e ->
-    let e = Errors.push e in
+    let e = CErrors.push e in
     msg_error (str"File " ++ str name ++ str ":" ++ spc () ++ iprint e);
     exit 1
 
-let merge_proof_branch ?valid ?id qast keep brname =
+let merge_proof_branch ~valid ?id qast keep brname =
   let brinfo = VCS.get_branch brname in
   let qed fproof = { qast; keep; brname; brinfo; fproof } in
   match brinfo with
@@ -2058,7 +2462,7 @@ let merge_proof_branch ?valid ?id qast keep brname =
       let id = VCS.new_node ?id () in
       VCS.merge id ~ours:(Qed (qed None)) brname;
       VCS.delete_branch brname;
-      if keep <> VtDrop then VCS.propagate_sideff None;
+      VCS.propagate_sideff None;
       `Ok
   | { VCS.kind = `Edit (mode, qed_id, master_id, _,_) } ->
       let ofp =
@@ -2072,12 +2476,12 @@ let merge_proof_branch ?valid ?id qast keep brname =
       VCS.checkout VCS.Branch.master;
       `Unfocus qed_id
   | { VCS.kind = `Master } ->
-       iraise (State.exn_on ?valid Stateid.dummy (Proof_global.NoCurrentProof, Exninfo.null))
+       iraise (State.exn_on ~valid Stateid.dummy (Proof_global.NoCurrentProof, Exninfo.null))
 
 (* When tty is true, this code also does some of the job of the user interface:
    jump back to a state that is valid *)
 let handle_failure (e, info) vcs tty =
-  if e = Errors.Drop then iraise (e, info) else
+  if e = CErrors.Drop then iraise (e, info) else
   match Stateid.get info with
   | None ->
       VCS.restore vcs;
@@ -2089,7 +2493,7 @@ let handle_failure (e, info) vcs tty =
       end;
       VCS.print ();
       anomaly(str"error with no safe_id attached:" ++ spc() ++
-        Errors.iprint_no_report (e, info))
+        CErrors.iprint_no_report (e, info))
   | Some (safe_id, id) ->
       prerr_endline (fun () -> "Failed at state " ^ Stateid.to_string id);
       VCS.restore vcs;
@@ -2102,20 +2506,18 @@ let handle_failure (e, info) vcs tty =
       VCS.print ();
       iraise (e, info)
 
-let snapshot_vio ldir long_f_dot_v =
+let snapshot_vio ldir long_f_dot_vo =
   finish ();
   if List.length (VCS.branches ()) > 1 then
-    Errors.errorlabstrm "stm" (str"Cannot dump a vio with open proofs");
-  Library.save_library_to ~todo:(dump_snapshot ()) ldir long_f_dot_v
+    CErrors.user_err ~hdr:"stm" (str"Cannot dump a vio with open proofs");
+  Library.save_library_to ~todo:(dump_snapshot ()) ldir long_f_dot_vo
     (Global.opaque_tables ())
 
 let reset_task_queue = Slaves.reset_task_queue
 
 (* Document building *)
-let process_transaction ?(newtip=Stateid.fresh ()) ~tty verbose c (loc, expr) =
-  let warn_if_pos a b =
-    if b then msg_warning(pr_ast a ++ str" should not be part of a script") in
-  let v, x = expr, { verbose = verbose; loc; expr } in
+let process_transaction ?(newtip=Stateid.fresh ()) ~tty
+  ({ verbose; loc; expr } as x) c =
   prerr_endline (fun () -> "{{{ processing: "^ string_of_ppcmds (pr_ast x));
   let vcs = VCS.backup () in
   try
@@ -2126,15 +2528,15 @@ let process_transaction ?(newtip=Stateid.fresh ()) ~tty verbose c (loc, expr) =
         "  classified as: " ^ string_of_vernac_classification c);
       match c with
       (* PG stuff *)    
-      | VtStm(VtPG,false), VtNow -> vernac_interp Stateid.dummy x; `Ok
+      | VtStm(VtPG,false), VtNow -> stm_vernac_interp Stateid.dummy x; `Ok
       | VtStm(VtPG,_), _ -> anomaly(str "PG command in script or VtLater")
       (* Joining various parts of the document *)
-      | VtStm (VtJoinDocument, b), VtNow -> warn_if_pos x b; join (); `Ok
-      | VtStm (VtFinish, b),       VtNow -> warn_if_pos x b; finish (); `Ok
-      | VtStm (VtWait, b),     VtNow -> warn_if_pos x b; finish (); wait (); `Ok
+      | VtStm (VtJoinDocument, b), VtNow -> join (); `Ok
+      | VtStm (VtFinish, b),       VtNow -> finish (); `Ok
+      | VtStm (VtWait, b),     VtNow -> finish (); wait (); `Ok
       | VtStm (VtPrintDag, b), VtNow ->
-          warn_if_pos x b; VCS.print ~now:true (); `Ok
-      | VtStm (VtObserve id, b),   VtNow -> warn_if_pos x b; observe id; `Ok
+          VCS.print ~now:true (); `Ok
+      | VtStm (VtObserve id, b),   VtNow -> observe id; `Ok
       | VtStm ((VtObserve _ | VtFinish | VtJoinDocument
                 |VtPrintDag |VtWait),_), VtLater ->
           anomaly(str"classifier: join actions cannot be classified as VtLater")
@@ -2143,9 +2545,10 @@ let process_transaction ?(newtip=Stateid.fresh ()) ~tty verbose c (loc, expr) =
       | VtStm (VtBack oid, true), w ->
           let id = VCS.new_node ~id:newtip () in
           let { mine; others } = Backtrack.branches_of oid in
+          let valid = VCS.get_branch_pos head in
           List.iter (fun branch ->
             if not (List.mem_assoc branch (mine::others)) then
-              ignore(merge_proof_branch x VtDrop branch))
+              ignore(merge_proof_branch ~valid x VtDrop branch))
             (VCS.branches ());
           VCS.checkout_shallowest_proof_branch ();
           let head = VCS.current_branch () in
@@ -2169,16 +2572,16 @@ let process_transaction ?(newtip=Stateid.fresh ()) ~tty verbose c (loc, expr) =
       (* Query *)
       | VtQuery (false,(report_id,route)), VtNow when tty = true ->
           finish ();
-          (try Future.purify (vernac_interp report_id ~route)
-                  { verbose = true; loc; expr }
-           with e when Errors.noncritical e ->
-             let e = Errors.push e in
-             iraise (State.exn_on report_id e)); `Ok
+          (try Future.purify (stm_vernac_interp report_id ~route)
+            {x with verbose = true }
+           with e when CErrors.noncritical e ->
+             let e = CErrors.push e in
+             iraise (State.exn_on ~valid:Stateid.dummy report_id e)); `Ok
       | VtQuery (false,(report_id,route)), VtNow ->
-          (try vernac_interp report_id ~route x
+          (try stm_vernac_interp report_id ~route x
            with e ->
-             let e = Errors.push e in
-             iraise (State.exn_on report_id e)); `Ok
+             let e = CErrors.push e in
+             iraise (State.exn_on ~valid:Stateid.dummy report_id e)); `Ok
       | VtQuery (true,(report_id,_)), w ->
           assert(Stateid.equal report_id Stateid.dummy);
           let id = VCS.new_node ~id:newtip () in
@@ -2189,8 +2592,7 @@ let process_transaction ?(newtip=Stateid.fresh ()) ~tty verbose c (loc, expr) =
                     may_pierce_opaque x
                  then `SkipQueue 
             else `MainQueue in
-          VCS.commit id (Cmd {
-            ctac=false;ceff=false;cast = x; cids = []; cqueue = queue });
+          VCS.commit id (mkTransCmd x [] false queue);
           Backtrack.record (); if w == VtNow then finish (); `Ok
       | VtQuery (false,_), VtLater ->
           anomaly(str"classifier: VtQuery + VtLater must imply part_of_script")
@@ -2213,8 +2615,7 @@ let process_transaction ?(newtip=Stateid.fresh ()) ~tty verbose c (loc, expr) =
           anomaly(str"VtProofMode must be executed VtNow")
       | VtProofMode mode, VtNow ->
           let id = VCS.new_node ~id:newtip () in
-          VCS.commit id (Cmd {
-            ctac=false;ceff=false;cast = x;cids=[];cqueue = `MainQueue});
+          VCS.commit id (mkTransCmd x [] false `MainQueue);
           List.iter
             (fun bn -> match VCS.get_branch bn with
             | { VCS.root; kind = `Master; pos } -> ()
@@ -2229,29 +2630,34 @@ let process_transaction ?(newtip=Stateid.fresh ()) ~tty verbose c (loc, expr) =
           Backtrack.record ();
           finish ();
           `Ok
-      | VtProofStep paral, w ->
+      | VtProofStep { parallel; proof_block_detection = cblock }, w ->
           let id = VCS.new_node ~id:newtip () in
-          let queue = if paral then `TacQueue (ref false) else `MainQueue in
-          VCS.commit id (Cmd {
-            ctac = true;ceff = false;cast = x;cids = [];cqueue = queue });
+          let queue =
+            match parallel with
+            | `Yes(solve,abstract) -> `TacQueue (solve, abstract, ref false)
+            | `No -> `MainQueue in
+          VCS.commit id (mkTransTac x cblock queue);
+          (* Static proof block detection delayed until an error really occurs.
+             If/when and UI will make something useful with this piece of info,
+             detection should occur here.
+          detect_proof_block id cblock; *)
           Backtrack.record (); if w == VtNow then finish (); `Ok
       | VtQed keep, w ->
-          let valid = if tty then Some(VCS.get_branch_pos head) else None in
-          let rc = merge_proof_branch ?valid ~id:newtip x keep head in
+          let valid = VCS.get_branch_pos head in
+          let rc = merge_proof_branch ~valid ~id:newtip x keep head in
           VCS.checkout_shallowest_proof_branch ();
           Backtrack.record (); if w == VtNow then finish ();
           rc
           
       (* Side effect on all branches *)
       | VtUnknown, _ when expr = VernacToplevelControl Drop ->
-          vernac_interp (VCS.get_branch_pos head) x; `Ok
+          stm_vernac_interp (VCS.get_branch_pos head) x; `Ok
 
       | VtSideff l, w ->
           let in_proof = not (VCS.Branch.equal head VCS.Branch.master) in
           let id = VCS.new_node ~id:newtip () in
           VCS.checkout VCS.Branch.master;
-          VCS.commit id (Cmd {
-            ctac=false;ceff=in_proof;cast=x;cids=l;cqueue=`MainQueue });
+          VCS.commit id (mkTransCmd x l in_proof `MainQueue);
           (* We can't replay a Definition since universes may be differently
            * inferred.  This holds in Coq >= 8.5 *)
 	  let replay = match x.expr with
@@ -2271,23 +2677,22 @@ let process_transaction ?(newtip=Stateid.fresh ()) ~tty verbose c (loc, expr) =
             VCS.checkout VCS.Branch.master;
             let mid = VCS.get_branch_pos VCS.Branch.master in
             Reach.known_state ~cache:(interactive ()) mid;
-            vernac_interp id x;
+            stm_vernac_interp id x;
             (* Vernac x may or may not start a proof *)
             if not in_proof && Proof_global.there_are_pending_proofs () then
             begin
               let bname = VCS.mk_branch_name x in
-              let opacity_of_produced_term =
-                match x.expr with
+              let rec opacity_of_produced_term = function
                 (* This AST is ambiguous, hence we check it dynamically *)
                 | VernacInstance (false, _,_ , None, _) -> GuaranteesOpacity
+                | VernacLocal (_,e) -> opacity_of_produced_term e
                 | _ -> Doesn'tGuaranteeOpacity in
-              VCS.commit id (Fork (x,bname,opacity_of_produced_term,[]));
+              VCS.commit id (Fork (x,bname,opacity_of_produced_term x.expr,[]));
               let proof_mode = default_proof_mode () in
               VCS.branch bname (`Proof (proof_mode, VCS.proof_nesting () + 1));
               Proof_global.activate_proof_mode proof_mode;
             end else begin
-	      VCS.commit id (Cmd {
-                ctac=false;ceff=in_proof;cast=x;cids=[];cqueue=`MainQueue });
+              VCS.commit id (mkTransCmd x [] in_proof `MainQueue);
               (* We hope it can be replayed, but we can't really know *)
               VCS.propagate_sideff ~replay:(Some x);
               VCS.checkout_shallowest_proof_branch ();
@@ -2299,11 +2704,11 @@ let process_transaction ?(newtip=Stateid.fresh ()) ~tty verbose c (loc, expr) =
           anomaly(str"classifier: VtUnknown must imply VtNow")
     end in
     (* Proof General *)
-    begin match v with 
+    begin match expr with 
       | VernacStm (PGLast _) ->
         if not (VCS.Branch.equal head VCS.Branch.master) then
-          vernac_interp Stateid.dummy
-            { verbose = true; loc = Loc.ghost;
+          stm_vernac_interp Stateid.dummy
+            { verbose = true; loc = Loc.ghost; indentation = 0; strlen = 0;
               expr = VernacShow (ShowGoal OpenSubgoals) }
       | _ -> ()
     end;
@@ -2311,37 +2716,44 @@ let process_transaction ?(newtip=Stateid.fresh ()) ~tty verbose c (loc, expr) =
     VCS.print ();
     rc
   with e ->
-    let e = Errors.push e in
+    let e = CErrors.push e in
     handle_failure e vcs tty
 
-let print_ast id =
-  try
-    match VCS.visit id with
-    | { step = `Cmd { cast = { loc; expr } } }
-    | { step = `Fork (({ loc; expr }, _, _, _), _) } 
-    | { step = `Qed ({ qast = { loc; expr } }, _) } ->
-        let xml = 
-          try Texmacspp.tmpp expr loc
-          with e -> Xml_datatype.PCData ("ERROR " ^ Printexc.to_string e) in
-        xml;
-    | _ -> Xml_datatype.PCData "ERROR"
-  with _ -> Xml_datatype.PCData "ERROR"
+let get_ast id =
+  match VCS.visit id with
+  | { step = `Cmd { cast = { loc; expr } } }
+  | { step = `Fork (({ loc; expr }, _, _, _), _) } 
+  | { step = `Qed ({ qast = { loc; expr } }, _) } ->
+         Some (expr, loc)
+  | _ -> None
 
 let stop_worker n = Slaves.cancel_worker n
 
+(* You may need to know the len + indentation of previous command to compute
+ * the indentation of the current one.
+ *  Eg.   foo. bar.
+ * Here bar is indented of the indentation of foo + its strlen (4) *)
+let ind_len_of id =
+  if Stateid.equal id Stateid.initial then 0
+  else match (VCS.visit id).step with
+  | `Cmd { ctac = true; cast = { indentation; strlen } } ->
+       indentation + strlen
+  | _ -> 0
+
 let add ~ontop ?newtip ?(check=ignore) verb eid s =
   let cur_tip = VCS.cur_tip () in
-  if Stateid.equal ontop cur_tip then begin
-    let _, ast as loc_ast = vernac_parse ?newtip eid s in
-    check(loc_ast);
-    let clas = classify_vernac ast in
-    match process_transaction ?newtip ~tty:false verb clas loc_ast with
-    | `Ok -> VCS.cur_tip (), `NewTip
-    | `Unfocus qed_id -> qed_id, `Unfocus (VCS.cur_tip ())
-  end else begin
+  if not (Stateid.equal ontop cur_tip) then
     (* For now, arbitrary edits should be announced with edit_at *)
-    anomaly(str"Not yet implemented, the GUI should not try this")
-  end
+    anomaly(str"Not yet implemented, the GUI should not try this");
+  let indentation, strlen, loc, ast =
+    vernac_parse ~indlen_prev:(fun () -> ind_len_of ontop) ?newtip eid s in
+  CWarnings.set_current_loc loc;
+  check(loc,ast);
+  let clas = classify_vernac ast in
+  let aast = { verbose = verb; indentation; strlen; loc; expr = ast } in
+  match process_transaction ?newtip ~tty:false aast clas with
+  | `Ok -> VCS.cur_tip (), `NewTip
+  | `Unfocus qed_id -> qed_id, `Unfocus (VCS.cur_tip ())
 
 let set_perspective id_list = Slaves.set_perspective id_list
 
@@ -2356,15 +2768,16 @@ let query ~at ?(report_with=(Stateid.dummy,default_route)) s =
     if Stateid.equal at Stateid.dummy then finish ()
     else Reach.known_state ~cache:`Yes at;
     let newtip, route = report_with in
-    let _, ast as loc_ast = vernac_parse ~newtip ~route 0 s in
+    let indentation, strlen, loc, ast = vernac_parse ~newtip ~route 0 s in
+    CWarnings.set_current_loc loc;
     let clas = classify_vernac ast in
+    let aast = { verbose = true; indentation; strlen; loc; expr = ast } in
     match clas with
     | VtStm (w,_), _ ->
-       ignore(process_transaction
-         ~tty:false true (VtStm (w,false), VtNow) loc_ast)
+       ignore(process_transaction ~tty:false aast (VtStm (w,false), VtNow))
     | _ ->
        ignore(process_transaction
-         ~tty:false true (VtQuery (false,report_with), VtNow) loc_ast))
+         ~tty:false aast (VtQuery (false,report_with), VtNow)))
   s
 
 let edit_at id =
@@ -2389,7 +2802,7 @@ let edit_at id =
     | _ -> assert false
   in
   let is_ancestor_of_cur_branch id =
-    Vcs_.NodeSet.mem id
+    Stateid.Set.mem id
       (VCS.reachable (VCS.get_branch_pos (VCS.current_branch ()))) in
   let has_failed qed_id =
     match VCS.visit qed_id with
@@ -2404,13 +2817,13 @@ let edit_at id =
       | { next } -> master_for_br root next in
   let reopen_branch start at_id mode qed_id tip old_branch =
     let master_id, cancel_switch, keep =
-      (* Hum, this should be the real start_id in the clusted and not next *)
+      (* Hum, this should be the real start_id in the cluster and not next *)
       match VCS.visit qed_id with
       | { step = `Qed ({ fproof = Some (_,cs); keep },_) } -> start, cs, keep
-      | _ -> anomaly (str "Cluster not ending with Qed") in
+      | _ -> anomaly (str "ProofTask not ending with Qed") in
     VCS.branch ~root:master_id ~pos:id
       VCS.edit_branch (`Edit (mode, qed_id, master_id, keep, old_branch));
-    VCS.delete_cluster_of id;
+    VCS.delete_boxes_of id;
     cancel_switch := true;
     Reach.known_state ~cache:(interactive ()) id;
     VCS.checkout_shallowest_proof_branch ();
@@ -2424,14 +2837,14 @@ let edit_at id =
     let { mine = brname, brinfo; others } = Backtrack.branches_of id in
     List.iter (fun (name,{ VCS.kind = k; root; pos }) ->
       if not(VCS.Branch.equal name VCS.Branch.master) &&
-         Vcs_.NodeSet.mem root ancestors then
+         Stateid.Set.mem root ancestors then
         VCS.branch ~root ~pos name k)
       others;
     VCS.reset_branch VCS.Branch.master (master_for_br brinfo.VCS.root id);
     VCS.branch ~root:brinfo.VCS.root ~pos:brinfo.VCS.pos
       (Option.default brname bn)
       (no_edit brinfo.VCS.kind);
-    VCS.delete_cluster_of id;
+    VCS.delete_boxes_of id;
     VCS.gc ();
     VCS.print ();
     if not !Flags.async_proofs_full then
@@ -2446,14 +2859,14 @@ let edit_at id =
         | Some{ mine = bn, { VCS.kind = `Proof(m,_) }} -> Some(m,bn)
         | Some{ mine = _, { VCS.kind = `Edit(m,_,_,_,bn) }} -> Some (m,bn)
         | _ -> None in
-      match focused, VCS.cluster_of id, branch_info with
+      match focused, VCS.proof_task_box_of id, branch_info with
       | _, Some _, None -> assert false
-      | false, Some (qed_id,start), Some(mode,bn) ->
+      | false, Some { qed = qed_id ; lemma = start }, Some(mode,bn) ->
           let tip = VCS.cur_tip () in
           if has_failed qed_id && is_pure qed_id && not !Flags.async_proofs_never_reopen_branch
           then reopen_branch start id mode qed_id tip bn
           else backto id (Some bn)
-      | true, Some (qed_id,_), Some(mode,bn) ->
+      | true, Some { qed = qed_id }, Some(mode,bn) ->
           if on_cur_branch id then begin
             assert false
           end else if is_ancestor_of_cur_branch id then begin
@@ -2478,12 +2891,12 @@ let edit_at id =
     VCS.print ();
     rc
   with e ->
-    let (e, info) = Errors.push e in
+    let (e, info) = CErrors.push e in
     match Stateid.get info with
     | None ->
         VCS.print ();
         anomaly (str ("edit_at "^Stateid.to_string id^": ") ++
-          Errors.print_no_report e)
+          CErrors.print_no_report e)
     | Some (_, id) ->
         prerr_endline (fun () -> "Failed at state " ^ Stateid.to_string id);
         VCS.restore vcs;
@@ -2496,9 +2909,10 @@ let restore d = VCS.restore d
 (*********************** TTY API (PG, coqtop, coqc) ***************************)
 (******************************************************************************)
 
-let interp verb (_,e as lexpr) =
+let interp verb (loc,e) =
   let clas = classify_vernac e in
-  let rc = process_transaction ~tty:true verb clas lexpr in
+  let aast = { verbose = verb; indentation = 0; strlen = 0; loc; expr = e } in
+  let rc = process_transaction ~tty:true aast clas in
   if rc <> `Ok then anomaly(str"tty loop can't be mixed with the STM protocol");
   if interactive () = `Yes ||
      (!Flags.async_proofs_mode = Flags.APoff &&
@@ -2511,7 +2925,7 @@ let interp verb (_,e as lexpr) =
        | _ -> not !Flags.coqtop_ui in
     try finish ~print_goals ()
     with e ->
-      let e = Errors.push e in
+      let e = CErrors.push e in
       handle_failure e vcs true
 
 let finish () = finish ()
@@ -2540,102 +2954,13 @@ let proofname b = match VCS.get_branch b with
 let get_all_proof_names () =
   List.map unmangle (List.map_filter proofname (VCS.branches ()))
 
-let get_current_proof_name () =
-  Option.map unmangle (proofname (VCS.current_branch ()))
-
-let get_script prf =
-  let branch, test =
-    match prf with
-    | None -> VCS.Branch.master, fun _ -> true
-    | Some name -> VCS.current_branch (),fun nl -> nl=[] || List.mem name nl in
-  let rec find acc id =
-    if Stateid.equal id Stateid.initial ||
-       Stateid.equal id Stateid.dummy then acc else
-    let view = VCS.visit id in
-    match view.step with
-    | `Fork((_,_,_,ns), _) when test ns -> acc
-    | `Qed (qed, proof) -> find [qed.qast.expr, (VCS.get_info id).n_goals] proof
-    | `Sideff (`Ast (x,_)) ->
-         find ((x.expr, (VCS.get_info id).n_goals)::acc) view.next
-    | `Sideff (`Id id)  -> find acc id
-    | `Cmd {cast = x; ctac} when ctac -> (* skip non-tactics *)
-         find ((x.expr, (VCS.get_info id).n_goals)::acc) view.next 
-    | `Cmd _ -> find acc view.next
-    | `Alias (id,_) -> find acc id
-    | `Fork _ -> find acc view.next
-    in
-  find [] (VCS.get_branch_pos branch)
-
-(* indentation code for Show Script, initially contributed
-   by D. de Rauglaudre *)
-
-let indent_script_item ((ng1,ngl1),nl,beginend,ppl) (cmd,ng) =
-  (* ng1 : number of goals remaining at the current level (before cmd)
-     ngl1 : stack of previous levels with their remaining goals
-     ng : number of goals after the execution of cmd
-     beginend : special indentation stack for { } *)
-  let ngprev = List.fold_left (+) ng1 ngl1 in
-  let new_ngl =
-    if ng > ngprev then
-      (* We've branched *)
-      (ng - ngprev + 1, ng1 - 1 :: ngl1)
-    else if ng < ngprev then
-      (* A subgoal have been solved. Let's compute the new current level
-	 by discarding all levels with 0 remaining goals. *)
-      let rec loop = function
-	| (0, ng2::ngl2) -> loop (ng2,ngl2)
-	| p -> p
-      in loop (ng1-1, ngl1)
-    else
-      (* Standard case, same goal number as before *)
-      (ng1, ngl1)
-  in
-  (* When a subgoal have been solved, separate this block by an empty line *)
-  let new_nl = (ng < ngprev)
-  in
-  (* Indentation depth *)
-  let ind = List.length ngl1
-  in
-  (* Some special handling of bullets and { }, to get a nicer display *)
-  let pred n = max 0 (n-1) in
-  let ind, nl, new_beginend = match cmd with
-    | VernacSubproof _ -> pred ind, nl, (pred ind)::beginend
-    | VernacEndSubproof -> List.hd beginend, false, List.tl beginend
-    | VernacBullet _ -> pred ind, nl, beginend
-    | _ -> ind, nl, beginend
-  in
-  let pp =
-    (if nl then fnl () else mt ()) ++
-    (hov (ind+1) (str (String.make ind ' ') ++ Ppvernac.pr_vernac cmd))
-  in
-  (new_ngl, new_nl, new_beginend, pp :: ppl)
-
-let show_script ?proof () =
-  try
-    let prf =
-      try match proof with
-      | None -> Some (Pfedit.get_current_proof_name ())
-      | Some (p,_) -> Some (p.Proof_global.id)
-      with Proof_global.NoCurrentProof -> None
-    in
-    let cmds = get_script prf in
-    let _,_,_,indented_cmds =
-      List.fold_left indent_script_item ((1,[]),false,[],[]) cmds
-    in
-    let indented_cmds = List.rev (indented_cmds) in
-    msg_notice (v 0 (prlist_with_sep fnl (fun x -> x) indented_cmds))
-  with Vcs_aux.Expired -> ()
-
 (* Export hooks *)
 let state_computed_hook = Hooks.state_computed_hook
 let state_ready_hook = Hooks.state_ready_hook
 let parse_error_hook = Hooks.parse_error_hook
-let execution_error_hook = Hooks.execution_error_hook
 let forward_feedback_hook = Hooks.forward_feedback_hook
 let process_error_hook = Hooks.process_error_hook
-let interp_hook = Hooks.interp_hook
-let with_fail_hook = Hooks.with_fail_hook
 let unreachable_state_hook = Hooks.unreachable_state_hook
-let get_fix_exn () = !State.fix_exn_ref
+let () = Hook.set Obligations.stm_get_fix_exn (fun () -> !State.fix_exn_ref)
 let tactic_being_run_hook = Hooks.tactic_being_run_hook
 (* vim:set foldmethod=marker: *)
diff --git a/stm/stm.mli b/stm/stm.mli
index 6519a6254..0f0a3c4e1 100644
--- a/stm/stm.mli
+++ b/stm/stm.mli
@@ -20,7 +20,9 @@ open Loc
    The sentence [s] is parsed in the state [ontop].
    If [newtip] is provided, then the returned state id is guaranteed to be
    [newtip] *)
-val add : ontop:Stateid.t -> ?newtip:Stateid.t -> ?check:(vernac_expr located -> unit) ->
+val add :
+  ontop:Stateid.t -> ?newtip:Stateid.t ->
+  ?check:(vernac_expr located -> unit) ->
   bool -> edit_id -> string ->
     Stateid.t * [ `NewTip | `Unfocus of Stateid.t ]
 
@@ -76,7 +78,9 @@ val get_current_state : unit -> Stateid.t
 
 (* Misc *)
 val init : unit -> unit
-val print_ast : Stateid.t -> Xml_datatype.xml
+
+(* This returns the node at that position *)
+val get_ast : Stateid.t -> (Vernacexpr.vernac_expr * Loc.t) option
 
 (* Filename *)
 val set_compilation_hints : string -> unit
@@ -94,6 +98,82 @@ module ProofTask : AsyncTaskQueue.Task
 module TacTask   : AsyncTaskQueue.Task
 module QueryTask : AsyncTaskQueue.Task
 
+(** document structure customization *************************************** **)
+
+(* A proof block delimiter defines a syntactic delimiter for sub proofs
+   that, when contain an error, do not impact the rest of the proof.
+   While checking a proof, if an error occurs in a (valid) block then
+   processing can skip the entire block and go on to give feedback
+   on the rest of the proof.
+  
+   static_block_detection and dynamic_block_validation are run when
+   the closing block marker is parsed/executed respectively.
+  
+   static_block_detection is for example called when "}" is parsed and
+   declares a block containing all proof steps between it and the matching
+   "{".
+  
+   dynamic_block_validation is called when an error "crosses" the "}" statement.
+   Depending on the nature of the goal focused by "{" the block may absorb the
+   error or not.  For example if the focused goal occurs in the type of
+   another goal, then the block is leaky.
+   Note that one can design proof commands that need no dynamic validation.
+  
+   Example of document:
+
+      .. { tac1. tac2. } ..
+
+   Corresponding DAG:
+
+      .. (3) <-- { -- (4) <-- tac1 -- (5) <-- tac2 -- (6) <-- } -- (7) ..
+                       
+   Declaration of block  [-------------------------------------------]
+
+      start = 5            the first state_id that could fail in the block
+      stop = 7             the node that may absorb the error
+      dynamic_switch = 4   dynamic check on this node
+      carry_on_data = ()   no need to carry extra data from static to dynamic
+                           checks
+*)
+
+module DynBlockData : Dyn.S
+
+type static_block_declaration = {
+  block_start : Stateid.t;
+  block_stop : Stateid.t;
+  dynamic_switch : Stateid.t;
+  carry_on_data : DynBlockData.t;
+}
+
+type document_node = {
+  indentation : int;
+  ast : Vernacexpr.vernac_expr;
+  id : Stateid.t;
+}
+
+type document_view = {
+  entry_point : document_node;
+  prev_node : document_node -> document_node option;
+}
+
+type static_block_detection =
+  document_view -> static_block_declaration option
+
+type recovery_action = {
+  base_state : Stateid.t;
+  goals_to_admit : Goal.goal list;
+  recovery_command : Vernacexpr.vernac_expr option;
+}
+
+type dynamic_block_error_recovery =
+  static_block_declaration -> [ `ValidBlock of recovery_action | `Leaks ]
+
+val register_proof_block_delimiter :
+  Vernacexpr.proof_block_name ->
+  static_block_detection ->
+  dynamic_block_error_recovery ->
+    unit
+
 (** customization ********************************************************** **)
 
 (* From the master (or worker, but beware that to install the hook
@@ -104,7 +184,6 @@ module QueryTask : AsyncTaskQueue.Task
 val state_computed_hook : (Stateid.t -> in_cache:bool -> unit) Hook.t
 val parse_error_hook :
   (Feedback.edit_or_state_id -> Loc.t -> Pp.std_ppcmds -> unit) Hook.t
-val execution_error_hook : (Stateid.t -> Loc.t -> Pp.std_ppcmds -> unit) Hook.t
 val unreachable_state_hook : (Stateid.t -> Exninfo.iexn -> unit) Hook.t
 (* ready means that master has it at hand *)
 val state_ready_hook : (Stateid.t -> unit) Hook.t
@@ -120,7 +199,8 @@ type state = {
   proof : Proof_global.state;
   shallow : bool
 }
-val state_of_id : Stateid.t -> [ `Valid of state option | `Expired ]
+val state_of_id :
+  Stateid.t -> [ `Valid of state option | `Expired | `Error of exn ]
 
 (** read-eval-print loop compatible interface ****************************** **)
 
@@ -132,12 +212,6 @@ val interp : bool -> vernac_expr located -> unit
 (* Queries for backward compatibility *)
 val current_proof_depth : unit -> int
 val get_all_proof_names : unit -> Id.t list
-val get_current_proof_name : unit -> Id.t option
-val show_script : ?proof:Proof_global.closed_proof -> unit -> unit
 
 (* Hooks to be set by other Coq components in order to break file cycles *)
 val process_error_hook : Future.fix_exn Hook.t
-val interp_hook : (?verbosely:bool -> ?proof:Proof_global.closed_proof ->
-  Loc.t * Vernacexpr.vernac_expr -> unit) Hook.t
-val with_fail_hook : (bool -> (unit -> unit) -> unit) Hook.t
-val get_fix_exn : unit -> (Exninfo.iexn -> Exninfo.iexn)
diff --git a/stm/stm.mllib b/stm/stm.mllib
index 92b3a869a..4b254e811 100644
--- a/stm/stm.mllib
+++ b/stm/stm.mllib
@@ -4,9 +4,8 @@ Vcs
 TQueue
 WorkerPool
 Vernac_classifier
-Lemmas
 CoqworkmgrApi
 AsyncTaskQueue
-Texmacspp
 Stm
+ProofBlockDelimiter
 Vio_checking
diff --git a/stm/tQueue.ml b/stm/tQueue.ml
index ee121c46a..a0b08778b 100644
--- a/stm/tQueue.ml
+++ b/stm/tQueue.ml
@@ -87,7 +87,7 @@ let broadcast { lock = m; cond = c } =
   Mutex.unlock m
 
 let push { queue = q; lock = m; cond = c; release } x =
-  if release then Errors.anomaly(Pp.str
+  if release then CErrors.anomaly(Pp.str
     "TQueue.push while being destroyed! Only 1 producer/destroyer allowed");
   Mutex.lock m;
   PriorityQueue.push q x;
diff --git a/stm/vcs.ml b/stm/vcs.ml
index 38c029901..d3886464d 100644
--- a/stm/vcs.ml
+++ b/stm/vcs.ml
@@ -7,7 +7,7 @@
 (************************************************************************)
 
 open Pp
-open Errors
+open CErrors
 
 module type S = sig
 
@@ -22,51 +22,49 @@ module type S = sig
   end
 
   type id
-
-  (* Branches have [branch_info] attached to them. *)
+  
   type ('kind) branch_info = {
     kind : [> `Master] as 'kind;
     root : id;
     pos  : id;
   }
-
-  type ('kind,'diff,'info) t constraint 'kind = [> `Master ]
-
-  val empty : id -> ('kind,'diff,'info) t
-
-  val current_branch : ('k,'e,'i) t -> Branch.t
-  val branches : ('k,'e,'i) t -> Branch.t list
-
-  val get_branch : ('k,'e,'i) t -> Branch.t -> 'k branch_info
-  val reset_branch : ('k,'e,'i) t -> Branch.t -> id -> ('k,'e,'i) t
+  
+  type ('kind,'diff,'info,'property_data) t constraint 'kind = [> `Master ]
+  
+  val empty : id -> ('kind,'diff,'info,'property_data) t
+  
+  val current_branch : ('k,'e,'i,'c) t -> Branch.t
+  val branches : ('k,'e,'i,'c) t -> Branch.t list
+  
+  val get_branch : ('k,'e,'i,'c) t -> Branch.t -> 'k branch_info
+  val reset_branch : ('k,'e,'i,'c) t -> Branch.t -> id -> ('k,'e,'i,'c) t
   val branch :
-    ('kind,'e,'i) t -> ?root:id -> ?pos:id ->
-        Branch.t -> 'kind -> ('kind,'e,'i) t
-  val delete_branch : ('k,'e,'i) t -> Branch.t -> ('k,'e,'i) t
+    ('kind,'e,'i,'c) t -> ?root:id -> ?pos:id ->
+        Branch.t -> 'kind -> ('kind,'e,'i,'c) t
+  val delete_branch : ('k,'e,'i,'c) t -> Branch.t -> ('k,'e,'i,'c) t
   val merge :
-    ('k,'diff,'i) t -> id -> ours:'diff -> theirs:'diff -> ?into:Branch.t ->
-            Branch.t -> ('k,'diff,'i) t
-  val commit : ('k,'diff,'i) t -> id -> 'diff -> ('k,'diff,'i) t
+    ('k,'diff,'i,'c) t -> id -> ours:'diff -> theirs:'diff -> ?into:Branch.t ->
+            Branch.t -> ('k,'diff,'i,'c) t
+  val commit : ('k,'diff,'i,'c) t -> id -> 'diff -> ('k,'diff,'i,'c) t
   val rewrite_merge :
-    ('k,'diff,'i) t -> id -> ours:'diff -> theirs:'diff -> at:id ->
-            Branch.t -> ('k,'diff,'i) t
-  val checkout : ('k,'e,'i) t -> Branch.t -> ('k,'e,'i) t
-
-  val set_info : ('k,'e,'info) t -> id -> 'info -> ('k,'e,'info) t
-  val get_info : ('k,'e,'info) t -> id -> 'info option
+    ('k,'diff,'i,'c) t -> id -> ours:'diff -> theirs:'diff -> at:id ->
+            Branch.t -> ('k,'diff,'i,'c) t
+  val checkout : ('k,'e,'i,'c) t -> Branch.t -> ('k,'e,'i,'c) t
   
-  module NodeSet : Set.S with type elt = id
-
-  val gc : ('k,'e,'info) t -> ('k,'e,'info) t * NodeSet.t
-
-  val reachable : ('k,'e,'info) t -> id -> NodeSet.t
+  val set_info : ('k,'e,'info,'c) t -> id -> 'info -> ('k,'e,'info,'c) t
+  val get_info : ('k,'e,'info,'c) t -> id -> 'info option
 
+  (* Read only dag *)
   module Dag : Dag.S with type node = id
-  val dag : ('kind,'diff,'info) t -> ('diff,'info,id*id) Dag.t
+  val dag : ('kind,'diff,'info,'cdata) t -> ('diff,'info,'cdata) Dag.t
+
+  val create_property : ('k,'e,'i,'c) t -> id list -> 'c -> ('k,'e,'i,'c) t
+  val property_of : ('k,'e,'i,'c) t -> id -> 'c Dag.Property.t list
+  val delete_property : ('k,'e,'i,'c) t -> 'c Dag.Property.t -> ('k,'e,'i,'c) t 
 
-  val create_cluster : ('k,'e,'i) t -> id list -> (id * id) -> ('k,'e,'i) t
-  val cluster_of : ('k,'e,'i) t -> id -> (id * id) Dag.Cluster.t option
-  val delete_cluster : ('k,'e,'i) t -> (id * id) Dag.Cluster.t -> ('k,'e,'i) t 
+  (* Removes all unreachable nodes and returns them *)
+  val gc : ('k,'e,'info,'c) t -> ('k,'e,'info,'c) t * Dag.NodeSet.t
+  val reachable : ('k,'e,'info,'c) t -> id -> Dag.NodeSet.t
 
 end
 
@@ -78,7 +76,6 @@ type id = OT.t
 
 module NodeSet = Dag.NodeSet
 
-
 module Branch =
 struct
   type t = string
@@ -99,10 +96,10 @@ type 'kind branch_info = {
   pos  : id;
 }
 
-type ('kind,'edge,'info) t = {
+type ('kind,'edge,'info,'property_data) t = {
   cur_branch   : Branch.t;
   heads        : 'kind branch_info BranchMap.t;
-  dag          : ('edge,'info,id*id) Dag.t;
+  dag          : ('edge,'info,'property_data) Dag.t;
 }
 
 let empty root = {
@@ -167,9 +164,9 @@ let checkout vcs name = { vcs with cur_branch = name }
 let set_info vcs id info = { vcs with dag = Dag.set_info vcs.dag id info }
 let get_info vcs id = Dag.get_info vcs.dag id
 
-let create_cluster vcs l i = { vcs with dag = Dag.create_cluster vcs.dag l i }
-let cluster_of vcs i = Dag.cluster_of vcs.dag i
-let delete_cluster vcs c = { vcs with dag = Dag.del_cluster vcs.dag c }
+let create_property vcs l i = { vcs with dag = Dag.create_property vcs.dag l i }
+let property_of vcs i = Dag.property_of vcs.dag i
+let delete_property vcs c = { vcs with dag = Dag.del_property vcs.dag c }
 
 let branches vcs = BranchMap.fold (fun x _ accu -> x :: accu) vcs.heads []
 let dag vcs = vcs.dag
diff --git a/stm/vcs.mli b/stm/vcs.mli
index 8f22fee84..46b40f8a4 100644
--- a/stm/vcs.mli
+++ b/stm/vcs.mli
@@ -19,10 +19,11 @@
    As a consequence, "checkout" just updates the current branch.
 
    The type [id] is the type of commits (a node in the dag)
-   The type [Vcs.t] has 3 parameters:
+   The type [Vcs.t] has 4 parameters:
     ['info] data attached to a node (like a system state)
     ['diff] data attached to an edge (the commit content, a "patch")
     ['kind] extra data attached to a branch (like being the master branch)
+    ['cdata] extra data hold by dag properties
 *)
 
 module type S = sig
@@ -45,46 +46,51 @@ module type S = sig
     pos  : id;
   }
   
-  type ('kind,'diff,'info) t constraint 'kind = [> `Master ]
+  type ('kind,'diff,'info,'property_data) t constraint 'kind = [> `Master ]
   
-  val empty : id -> ('kind,'diff,'info) t
+  val empty : id -> ('kind,'diff,'info,'property_data) t
   
-  val current_branch : ('k,'e,'i) t -> Branch.t
-  val branches : ('k,'e,'i) t -> Branch.t list
+  val current_branch : ('k,'e,'i,'c) t -> Branch.t
+  val branches : ('k,'e,'i,'c) t -> Branch.t list
   
-  val get_branch : ('k,'e,'i) t -> Branch.t -> 'k branch_info
-  val reset_branch : ('k,'e,'i) t -> Branch.t -> id -> ('k,'e,'i) t
+  val get_branch : ('k,'e,'i,'c) t -> Branch.t -> 'k branch_info
+  val reset_branch : ('k,'e,'i,'c) t -> Branch.t -> id -> ('k,'e,'i,'c) t
   val branch :
-    ('kind,'e,'i) t -> ?root:id -> ?pos:id ->
-        Branch.t -> 'kind -> ('kind,'e,'i) t
-  val delete_branch : ('k,'e,'i) t -> Branch.t -> ('k,'e,'i) t
+    ('kind,'e,'i,'c) t -> ?root:id -> ?pos:id ->
+        Branch.t -> 'kind -> ('kind,'e,'i,'c) t
+  val delete_branch : ('k,'e,'i,'c) t -> Branch.t -> ('k,'e,'i,'c) t
   val merge :
-    ('k,'diff,'i) t -> id -> ours:'diff -> theirs:'diff -> ?into:Branch.t ->
-            Branch.t -> ('k,'diff,'i) t
-  val commit : ('k,'diff,'i) t -> id -> 'diff -> ('k,'diff,'i) t
+    ('k,'diff,'i,'c) t -> id -> ours:'diff -> theirs:'diff -> ?into:Branch.t ->
+            Branch.t -> ('k,'diff,'i,'c) t
+  val commit : ('k,'diff,'i,'c) t -> id -> 'diff -> ('k,'diff,'i,'c) t
   val rewrite_merge :
-    ('k,'diff,'i) t -> id -> ours:'diff -> theirs:'diff -> at:id ->
-            Branch.t -> ('k,'diff,'i) t
-  val checkout : ('k,'e,'i) t -> Branch.t -> ('k,'e,'i) t
+    ('k,'diff,'i,'c) t -> id -> ours:'diff -> theirs:'diff -> at:id ->
+            Branch.t -> ('k,'diff,'i,'c) t
+  val checkout : ('k,'e,'i,'c) t -> Branch.t -> ('k,'e,'i,'c) t
   
-  val set_info : ('k,'e,'info) t -> id -> 'info -> ('k,'e,'info) t
-  val get_info : ('k,'e,'info) t -> id -> 'info option
+  val set_info : ('k,'e,'info,'c) t -> id -> 'info -> ('k,'e,'info,'c) t
+  val get_info : ('k,'e,'info,'c) t -> id -> 'info option
 
-  module NodeSet : Set.S with type elt = id
+  (* Read only dag *)
+  module Dag : Dag.S with type node = id
+  val dag : ('kind,'diff,'info,'cdata) t -> ('diff,'info,'cdata) Dag.t
   
-  (* Removes all unreachable nodes and returns them *)
-  val gc : ('k,'e,'info) t -> ('k,'e,'info) t * NodeSet.t
+  (* Properties are not a concept typical of a VCS, but a useful metadata
+   * of a DAG (or graph). *)
+  val create_property : ('k,'e,'i,'c) t -> id list -> 'c -> ('k,'e,'i,'c) t
+  val property_of : ('k,'e,'i,'c) t -> id -> 'c Dag.Property.t list
+  val delete_property : ('k,'e,'i,'c) t -> 'c Dag.Property.t -> ('k,'e,'i,'c) t 
 
-  val reachable : ('k,'e,'info) t -> id -> NodeSet.t
+  (* Removes all unreachable nodes and returns them *)
+  val gc : ('k,'e,'info,'c) t -> ('k,'e,'info,'c) t * Dag.NodeSet.t
+  val reachable : ('k,'e,'info,'c) t -> id -> Dag.NodeSet.t
 
-  (* read only dag *)
-  module Dag : Dag.S with type node = id
-  val dag : ('kind,'diff,'info) t -> ('diff,'info,id * id) Dag.t
  
-  val create_cluster : ('k,'e,'i) t -> id list -> (id * id) -> ('k,'e,'i) t
-  val cluster_of : ('k,'e,'i) t -> id -> (id * id) Dag.Cluster.t option
-  val delete_cluster : ('k,'e,'i) t -> (id * id) Dag.Cluster.t -> ('k,'e,'i) t 
-
 end
 
-module Make(OT : Map.OrderedType) : S with type id = OT.t
+module Make(OT : Map.OrderedType) : S
+with type id = OT.t
+and type Dag.node = OT.t
+and type Dag.NodeSet.t = Set.Make(OT).t
+and type Dag.NodeSet.elt = OT.t
+
diff --git a/stm/vernac_classifier.ml b/stm/vernac_classifier.ml
index b1df3c9ca..dc5be08a3 100644
--- a/stm/vernac_classifier.ml
+++ b/stm/vernac_classifier.ml
@@ -7,13 +7,18 @@
 (************************************************************************)
 
 open Vernacexpr
-open Errors
+open CErrors
 open Pp
 
 let default_proof_mode () = Proof_global.get_default_proof_mode_name ()
 
 let string_of_in_script b = if b then " (inside script)" else ""
 
+let string_of_parallel = function
+  | `Yes (solve,abs) ->
+       "par" ^ if solve then "solve" else "" ^ if abs then "abs" else ""
+  | `No -> ""
+
 let string_of_vernac_type = function
   | VtUnknown -> "Unknown"
   | VtStartProof _ -> "StartProof"
@@ -21,8 +26,9 @@ let string_of_vernac_type = function
   | VtQed VtKeep -> "Qed(keep)"
   | VtQed VtKeepAsAxiom -> "Qed(admitted)"
   | VtQed VtDrop -> "Qed(drop)"
-  | VtProofStep false -> "ProofStep"
-  | VtProofStep true -> "ProofStep (parallel)"
+  | VtProofStep { parallel; proof_block_detection } ->
+      "ProofStep " ^ string_of_parallel parallel ^
+        Option.default "" proof_block_detection
   | VtProofMode s -> "ProofMode " ^ s
   | VtQuery (b,(id,route)) ->
       "Query " ^ string_of_in_script b ^ " report " ^ Stateid.to_string id ^
@@ -93,7 +99,9 @@ let rec classify_vernac e =
         (match classify_vernac e with
         | ( VtQuery _ | VtProofStep _ | VtSideff _
           | VtStm _ | VtProofMode _ ), _ as x -> x
-        | VtQed _, _ -> VtProofStep false, VtNow
+        | VtQed _, _ ->
+            VtProofStep { parallel = `No; proof_block_detection = None },
+            VtNow
         | (VtStartProof _ | VtUnknown), _ -> VtUnknown, VtNow)
     (* Qed *)
     | VernacAbort _ -> VtQed VtDrop, VtLater
@@ -105,12 +113,19 @@ let rec classify_vernac e =
         VtQuery (true,(Stateid.dummy,Feedback.default_route)), VtLater
     (* ProofStep *)
     | VernacProof _ 
-    | VernacBullet _ 
     | VernacFocus _ | VernacUnfocus
-    | VernacSubproof _ | VernacEndSubproof
+    | VernacSubproof _
     | VernacCheckGuard
     | VernacUnfocused
-    | VernacSolveExistential _ -> VtProofStep false, VtLater
+    | VernacSolveExistential _ ->
+        VtProofStep { parallel = `No; proof_block_detection = None }, VtLater
+    | VernacBullet _ ->
+        VtProofStep { parallel = `No; proof_block_detection = Some "bullet" },
+        VtLater
+    | VernacEndSubproof -> 
+        VtProofStep { parallel = `No;
+                      proof_block_detection = Some "curly" },
+        VtLater
     (* Options changing parser *)
     | VernacUnsetOption (["Default";"Proof";"Using"])
     | VernacSetOption (["Default";"Proof";"Using"],_) -> VtSideff [], VtNow
@@ -166,7 +181,7 @@ let rec classify_vernac e =
     | VernacReserve _
     | VernacGeneralizable _
     | VernacSetOpacity _ | VernacSetStrategy _
-    | VernacUnsetOption _ | VernacSetOption _
+    | VernacUnsetOption _ | VernacSetOption _ | VernacSetAppendOption _
     | VernacAddOption _ | VernacRemoveOption _
     | VernacMemOption _ | VernacPrintOption _
     | VernacGlobalCheck _
@@ -219,4 +234,4 @@ let rec classify_vernac e =
 let classify_as_query =
   VtQuery (true,(Stateid.dummy,Feedback.default_route)), VtLater
 let classify_as_sideeff = VtSideff [], VtLater
-let classify_as_proofstep = VtProofStep false, VtLater
+let classify_as_proofstep = VtProofStep { parallel = `No; proof_block_detection = None}, VtLater
diff --git a/stm/vio_checking.ml b/stm/vio_checking.ml
index d4dcf72c1..a6237daa0 100644
--- a/stm/vio_checking.ml
+++ b/stm/vio_checking.ml
@@ -24,7 +24,7 @@ end
 module Pool = Map.Make(IntOT)
 
 let schedule_vio_checking j fs =
-  if j < 1 then Errors.error "The number of workers must be bigger than 0";
+  if j < 1 then CErrors.error "The number of workers must be bigger than 0";
   let jobs = ref [] in
   List.iter (fun f ->
     let f =
@@ -98,7 +98,7 @@ let schedule_vio_checking j fs =
   exit !rc
 
 let schedule_vio_compilation j fs =
-  if j < 1 then Errors.error "The number of workers must be bigger than 0";
+  if j < 1 then CErrors.error "The number of workers must be bigger than 0";
   let jobs = ref [] in
   List.iter (fun f ->
     let f =
diff --git a/stm/workerPool.ml b/stm/workerPool.ml
index b94fae547..9623765de 100644
--- a/stm/workerPool.ml
+++ b/stm/workerPool.ml
@@ -52,7 +52,7 @@ let master_handshake worker_id ic oc =
       Printf.eprintf "Handshake with %s failed: protocol mismatch\n" worker_id;
       exit 1;
     end
-  with e when Errors.noncritical e ->
+  with e when CErrors.noncritical e ->
     Printf.eprintf "Handshake with %s failed: %s\n"
       worker_id (Printexc.to_string e);
     exit 1
@@ -65,7 +65,7 @@ let worker_handshake slave_ic slave_oc =
       exit 1;
     end;
     Marshal.to_channel slave_oc v []; flush slave_oc;
-  with e when Errors.noncritical e ->
+  with e when CErrors.noncritical e ->
     prerr_endline ("Handshake failed: " ^ Printexc.to_string e);
     exit 1
 
diff --git a/tactics/auto.ml b/tactics/auto.ml
index e57b48e9e..7558a707e 100644
--- a/tactics/auto.ml
+++ b/tactics/auto.ml
@@ -10,7 +10,7 @@
 *)
 open Pp
 open Util
-open Errors
+open CErrors
 open Names
 open Vars
 open Termops
@@ -20,7 +20,6 @@ open Genredexpr
 open Tactics
 open Tacticals
 open Clenv
-open Tacexpr
 open Locus
 open Proofview.Notations
 open Hints
@@ -35,6 +34,10 @@ open Hints
 
 let priority l = List.filter (fun (_, hint) -> Int.equal hint.pri 0) l
 
+let compute_secvars gl =
+  let hyps = Proofview.Goal.hyps (Proofview.Goal.assume gl) in
+  secvars_of_hyps hyps
+
 (* tell auto not to reuse already instantiated metas in unification (for
    compatibility, since otherwise, apply succeeds oftener) *)
 
@@ -94,7 +97,7 @@ let connect_hint_clenv poly (c, _, ctx) clenv gl =
       let evd = Evd.merge_context_set Evd.univ_flexible evd ctx in
       { clenv with evd = evd ; env = Proofview.Goal.env gl }, c
   in clenv, c
-		     
+
 let unify_resolve poly flags ((c : raw_hint), clenv) =
   Proofview.Goal.nf_enter { enter = begin fun gl ->
   let clenv, c = connect_hint_clenv poly c clenv gl in
@@ -109,21 +112,11 @@ let unify_resolve_gen poly = function
   | Some flags -> unify_resolve poly flags
 
 let exact poly (c,clenv) =
-  let (c, _, _) = c in
-  let ctx, c' = 
-    if poly then
-      let evd', subst = Evd.refresh_undefined_universes clenv.evd in
-      let ctx = Evd.evar_universe_context evd' in
-	ctx, subst_univs_level_constr subst c 
-    else 
-      let ctx = Evd.evar_universe_context clenv.evd in
-	ctx, c
-  in
-  Proofview.Goal.s_enter { s_enter = begin fun gl ->
-    let sigma = Proofview.Goal.sigma gl in
-    let sigma = Sigma.to_evar_map sigma in
-    let sigma = Evd.merge_universe_context sigma ctx in
-    Sigma.Unsafe.of_pair (exact_check c', sigma)
+  Proofview.Goal.enter { enter = begin fun gl ->
+    let clenv', c = connect_hint_clenv poly c clenv gl in
+    Tacticals.New.tclTHEN
+    (Proofview.Unsafe.tclEVARUNIVCONTEXT (Evd.evar_universe_context clenv'.evd))
+    (exact_check c)
   end }
 
 (* Util *)
@@ -156,7 +149,7 @@ let conclPattern concl pat tac =
        constr_bindings env sigma >>= fun constr_bindings ->
      let open Genarg in
      let open Geninterp in
-     let inj c = match val_tag (topwit Constrarg.wit_constr) with
+     let inj c = match val_tag (topwit Stdarg.wit_constr) with
      | Val.Base tag -> Val.Dyn (tag, c)
      | _ -> assert false
      in
@@ -232,7 +225,7 @@ let tclLOG (dbg,depth,trace) pp tac =
 	  Feedback.msg_debug (str s ++ spc () ++ pp () ++ str ". (*success*)");
 	  out
 	with reraise ->
-          let reraise = Errors.push reraise in
+          let reraise = CErrors.push reraise in
 	  Feedback.msg_debug (str s ++ spc () ++ pp () ++ str ". (*fail*)");
 	  iraise reraise
       end
@@ -244,7 +237,7 @@ let tclLOG (dbg,depth,trace) pp tac =
 	  trace := (depth, Some pp) :: !trace;
 	  out
 	with reraise ->
-          let reraise = Errors.push reraise in
+          let reraise = CErrors.push reraise in
 	  trace := (depth, None) :: !trace;
 	  iraise reraise
       end
@@ -266,35 +259,29 @@ and erase_subtree depth = function
   | (d,_) :: l -> if Int.equal d depth then l else erase_subtree depth l
 
 let pr_info_atom (d,pp) =
-  str (String.make d ' ') ++ pp () ++ str "."
+  str (String.make (d-1) ' ') ++ pp () ++ str "."
 
 let pr_info_trace = function
   | (Info,_,{contents=(d,Some pp)::l}) ->
-      prlist_with_sep fnl pr_info_atom (cleanup_info_trace d [(d,pp)] l)
-  | _ -> mt ()
+      Feedback.msg_info (prlist_with_sep fnl pr_info_atom (cleanup_info_trace d [(d,pp)] l))
+  | _ -> ()
 
 let pr_info_nop = function
-  | (Info,_,_) -> str "idtac."
-  | _ -> mt ()
+  | (Info,_,_) -> Feedback.msg_info (str "idtac.")
+  | _ -> ()
 
 let pr_dbg_header = function
-  | (Off,_,_) -> mt ()
-  | (Debug,0,_) -> str "(* debug trivial : *)"
-  | (Debug,_,_) -> str "(* debug auto : *)"
-  | (Info,0,_) -> str "(* info trivial : *)"
-  | (Info,_,_) -> str "(* info auto : *)"
+  | (Off,_,_) -> ()
+  | (Debug,0,_) -> Feedback.msg_debug (str "(* debug trivial: *)")
+  | (Debug,_,_) -> Feedback.msg_debug (str "(* debug auto: *)")
+  | (Info,0,_) -> Feedback.msg_info (str "(* info trivial: *)")
+  | (Info,_,_) -> Feedback.msg_info (str "(* info auto: *)")
 
 let tclTRY_dbg d tac =
-  let (level, _, _) = d in
   let delay f = Proofview.tclUNIT () >>= fun () -> f () in
-  let tac = match level with
-  | Off -> tac
-  | Debug | Info -> delay (fun () -> Feedback.msg_debug (pr_dbg_header d ++ fnl () ++ pr_info_trace d); tac)
-  in
-  let after = match level with
-  | Info -> delay (fun () -> Feedback.msg_debug (pr_info_nop d); Proofview.tclUNIT ())
-  | Off | Debug -> Proofview.tclUNIT ()
-  in
+  let tac = delay (fun () -> pr_dbg_header d; tac) >>=
+              fun () -> pr_info_trace d; Proofview.tclUNIT () in
+  let after = delay (fun () -> pr_info_nop d; Proofview.tclUNIT ()) in
   Tacticals.New.tclORELSE0 tac after
 
 (**************************************************************************)
@@ -311,12 +298,13 @@ let flags_of_state st =
 let auto_flags_of_state st =
   auto_unif_flags_of full_transparent_state st false
 
-let hintmap_of hdc concl =
+let hintmap_of secvars hdc concl =
   match hdc with
-  | None -> Hint_db.map_none
+  | None -> Hint_db.map_none ~secvars
   | Some hdc ->
-      if occur_existential concl then Hint_db.map_existential hdc concl
-      else Hint_db.map_auto hdc concl
+     if occur_existential concl then
+       Hint_db.map_existential ~secvars hdc concl
+     else Hint_db.map_auto ~secvars hdc concl
 
 let exists_evaluable_reference env = function
   | EvalConstRef _ -> true
@@ -341,22 +329,23 @@ let rec trivial_fail_db dbg mod_delta db_list local_db =
   in
   Proofview.Goal.enter { enter = begin fun gl ->
     let concl = Tacmach.New.pf_nf_concl gl in
+    let secvars = compute_secvars gl in
     Tacticals.New.tclFIRST
       ((dbg_assumption dbg)::intro_tac::
           (List.map Tacticals.New.tclCOMPLETE
-             (trivial_resolve dbg mod_delta db_list local_db concl)))
+             (trivial_resolve dbg mod_delta db_list local_db secvars concl)))
   end }
 
-and my_find_search_nodelta db_list local_db hdc concl =
+and my_find_search_nodelta db_list local_db secvars hdc concl =
   List.map (fun hint -> (None,hint))
-    (List.map_append (hintmap_of hdc concl) (local_db::db_list))
+    (List.map_append (hintmap_of secvars hdc concl) (local_db::db_list))
 
 and my_find_search mod_delta =
   if mod_delta then my_find_search_delta
   else my_find_search_nodelta
 
-and my_find_search_delta db_list local_db hdc concl =
-  let f = hintmap_of hdc concl in
+and my_find_search_delta db_list local_db secvars hdc concl =
+  let f = hintmap_of secvars hdc concl in
     if occur_existential concl then
       List.map_append
 	(fun db ->
@@ -376,16 +365,16 @@ and my_find_search_delta db_list local_db hdc concl =
 	  let (ids, csts as st) = Hint_db.transparent_state db in
 	  let flags, l =
 	    let l =
-	      match hdc with None -> Hint_db.map_none db
+	      match hdc with None -> Hint_db.map_none ~secvars db
 	      | Some hdc ->
 		  if (Id.Pred.is_empty ids && Cpred.is_empty csts)
-		  then Hint_db.map_auto hdc concl db
-		  else Hint_db.map_existential hdc concl db
+		  then Hint_db.map_auto ~secvars hdc concl db
+		  else Hint_db.map_existential ~secvars hdc concl db
 	    in auto_flags_of_state st, l
 	  in List.map (fun x -> (Some flags,x)) l)
       	(local_db::db_list)
 
-and tac_of_hint dbg db_list local_db concl (flags, ({pat=p; code=t;poly=poly})) =
+and tac_of_hint dbg db_list local_db concl (flags, ({pat=p; code=t;poly=poly;db=dbname})) =
   let tactic = function
     | Res_pf (c,cl) -> unify_resolve_gen poly flags (c,cl)
     | ERes_pf _ -> Proofview.V82.tactic (fun gl -> error "eres_pf")
@@ -404,9 +393,16 @@ and tac_of_hint dbg db_list local_db concl (flags, ({pat=p; code=t;poly=poly}))
     | Extern tacast -> 
       conclPattern concl p tacast
   in
-  tclLOG dbg (fun () -> pr_hint t) (run_hint t tactic)
+  let pr_hint () =
+    let origin = match dbname with
+    | None -> mt ()
+    | Some n -> str " (in " ++ str n ++ str ")"
+    in
+    pr_hint t ++ origin
+  in
+  tclLOG dbg pr_hint (run_hint t tactic)
 
-and trivial_resolve dbg mod_delta db_list local_db cl =
+and trivial_resolve dbg mod_delta db_list local_db secvars cl =
   try
     let head =
       try let hdconstr = decompose_app_bound cl in
@@ -415,7 +411,7 @@ and trivial_resolve dbg mod_delta db_list local_db cl =
     in
       List.map (tac_of_hint dbg db_list local_db cl)
 	(priority
-	    (my_find_search mod_delta db_list local_db head cl))
+	    (my_find_search mod_delta db_list local_db secvars head cl))
   with Not_found -> []
 
 (** The use of the "core" database can be de-activated by passing
@@ -453,7 +449,7 @@ let h_trivial ?(debug=Off) lems l = gen_trivial ~debug lems l
 (*                       The classical Auto tactic                        *)
 (**************************************************************************)
 
-let possible_resolve dbg mod_delta db_list local_db cl =
+let possible_resolve dbg mod_delta db_list local_db secvars cl =
   try
     let head =
       try let hdconstr = decompose_app_bound cl in
@@ -461,7 +457,7 @@ let possible_resolve dbg mod_delta db_list local_db cl =
       with Bound -> None
     in
       List.map (tac_of_hint dbg db_list local_db cl)
-	(my_find_search mod_delta db_list local_db head cl)
+	(my_find_search mod_delta db_list local_db secvars head cl)
   with Not_found -> []
 
 let extend_local_db decl db gl =
@@ -492,11 +488,12 @@ let search d n mod_delta db_list local_db =
 	  (Tacticals.New.tclORELSE0 (intro_register d (search d n) local_db)
 	     ( Proofview.Goal.enter { enter = begin fun gl ->
                let concl = Tacmach.New.pf_nf_concl gl in
+               let secvars = compute_secvars gl in
 	       let d' = incr_dbg d in
 	       Tacticals.New.tclFIRST
 	         (List.map
 		    (fun ntac -> Tacticals.New.tclTHEN ntac (search d' (n-1) local_db))
-		    (possible_resolve d mod_delta db_list local_db concl))
+		    (possible_resolve d mod_delta db_list local_db secvars concl))
              end }))
     end []
   in
diff --git a/tactics/auto.mli b/tactics/auto.mli
index 8c4f35904..de0dbd483 100644
--- a/tactics/auto.mli
+++ b/tactics/auto.mli
@@ -6,24 +6,25 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
+(** This files implements auto and related automation tactics *)
+
 open Names
 open Term
 open Clenv
 open Pattern
 open Decl_kinds
 open Hints
+open Tactypes
 
-(** Auto and related automation tactics *)
-
-val priority : ('a * full_hint) list -> ('a * full_hint) list
+val compute_secvars : ('a,'b) Proofview.Goal.t -> Id.Pred.t
 
 val default_search_depth : int ref
 
 val auto_flags_of_state : transparent_state -> Unification.unify_flags
 
 val connect_hint_clenv : polymorphic -> raw_hint -> clausenv ->
-			 ([ `NF ], 'r) Proofview.Goal.t -> clausenv * constr
-						
+  ('a, 'r) Proofview.Goal.t -> clausenv * constr
+
 (** Try unification with the precompiled clause, then use registered Apply *)
 val unify_resolve : polymorphic -> Unification.unify_flags -> (raw_hint * clausenv) -> unit Proofview.tactic
 
@@ -39,45 +40,43 @@ val conclPattern : constr -> constr_pattern option -> Genarg.glob_generic_argume
 (** The use of the "core" database can be de-activated by passing
     "nocore" amongst the databases. *)
 
-val auto : ?debug:Tacexpr.debug ->
-  int -> Tacexpr.delayed_open_constr list -> hint_db_name list -> unit Proofview.tactic
+val auto : ?debug:debug ->
+  int -> delayed_open_constr list -> hint_db_name list -> unit Proofview.tactic
 
 (** Auto with more delta. *)
 
-val new_auto : ?debug:Tacexpr.debug ->
-  int -> Tacexpr.delayed_open_constr list -> hint_db_name list -> unit Proofview.tactic
+val new_auto : ?debug:debug ->
+  int -> delayed_open_constr list -> hint_db_name list -> unit Proofview.tactic
 
 (** auto with default search depth and with the hint database "core" *)
 val default_auto : unit Proofview.tactic
 
-(** auto with all hint databases except the "v62" compatibility database *)
-val full_auto : ?debug:Tacexpr.debug ->
-  int -> Tacexpr.delayed_open_constr list -> unit Proofview.tactic
+(** auto with all hint databases *)
+val full_auto : ?debug:debug ->
+  int -> delayed_open_constr list -> unit Proofview.tactic
 
-(** auto with all hint databases except the "v62" compatibility database
-   and doing delta *)
-val new_full_auto : ?debug:Tacexpr.debug ->
-  int -> Tacexpr.delayed_open_constr list -> unit Proofview.tactic
+(** auto with all hint databases and doing delta *)
+val new_full_auto : ?debug:debug ->
+  int -> delayed_open_constr list -> unit Proofview.tactic
 
-(** auto with default search depth and with all hint databases
-   except the "v62" compatibility database *)
+(** auto with default search depth and with all hint databases *)
 val default_full_auto : unit Proofview.tactic
 
 (** The generic form of auto (second arg [None] means all bases) *)
-val gen_auto : ?debug:Tacexpr.debug ->
-  int option -> Tacexpr.delayed_open_constr list -> hint_db_name list option -> unit Proofview.tactic
+val gen_auto : ?debug:debug ->
+  int option -> delayed_open_constr list -> hint_db_name list option -> unit Proofview.tactic
 
 (** The hidden version of auto *)
-val h_auto   : ?debug:Tacexpr.debug ->
-  int option -> Tacexpr.delayed_open_constr list -> hint_db_name list option -> unit Proofview.tactic
+val h_auto   : ?debug:debug ->
+  int option -> delayed_open_constr list -> hint_db_name list option -> unit Proofview.tactic
 
 (** Trivial *)
 
-val trivial : ?debug:Tacexpr.debug ->
-  Tacexpr.delayed_open_constr list -> hint_db_name list -> unit Proofview.tactic
-val gen_trivial : ?debug:Tacexpr.debug ->
-  Tacexpr.delayed_open_constr list -> hint_db_name list option -> unit Proofview.tactic
-val full_trivial : ?debug:Tacexpr.debug ->
-  Tacexpr.delayed_open_constr list -> unit Proofview.tactic
-val h_trivial : ?debug:Tacexpr.debug ->
-  Tacexpr.delayed_open_constr list -> hint_db_name list option -> unit Proofview.tactic
+val trivial : ?debug:debug ->
+  delayed_open_constr list -> hint_db_name list -> unit Proofview.tactic
+val gen_trivial : ?debug:debug ->
+  delayed_open_constr list -> hint_db_name list option -> unit Proofview.tactic
+val full_trivial : ?debug:debug ->
+  delayed_open_constr list -> unit Proofview.tactic
+val h_trivial : ?debug:debug ->
+  delayed_open_constr list -> hint_db_name list option -> unit Proofview.tactic
diff --git a/tactics/autorewrite.ml b/tactics/autorewrite.ml
index 9ae0ab90b..dae1cc9f1 100644
--- a/tactics/autorewrite.ml
+++ b/tactics/autorewrite.ml
@@ -13,7 +13,7 @@ open Tacticals
 open Tactics
 open Term
 open Termops
-open Errors
+open CErrors
 open Util
 open Mod_subst
 open Locus
@@ -65,7 +65,7 @@ let raw_find_base bas = String.Map.find bas !rewtab
 let find_base bas =
   try raw_find_base bas
   with Not_found ->
-    errorlabstrm "AutoRewrite"
+    user_err ~hdr:"AutoRewrite"
       (str "Rewriting base " ++ str bas ++ str " does not exist.")
 
 let find_rewrites bas =
@@ -83,7 +83,7 @@ let print_rewrite_hintdb bas =
 	     str (if h.rew_l2r then "rewrite -> " else "rewrite <- ") ++
 	       Printer.pr_lconstr h.rew_lemma ++ str " of type " ++ Printer.pr_lconstr h.rew_type ++
 	       Option.cata (fun tac -> str " then use tactic " ++
-	       Pptactic.pr_glb_generic (Global.env()) tac) (mt ()) h.rew_tac)
+	       Pputils.pr_glb_generic (Global.env()) tac) (mt ()) h.rew_tac)
 	   (find_rewrites bas))
 
 type raw_rew_rule = Loc.t * constr Univ.in_universe_context_set * bool * Genarg.raw_generic_argument option
@@ -294,8 +294,8 @@ let find_applied_relation metas loc env sigma c left2right =
     match decompose_applied_relation metas env sigma c ctype left2right with
     | Some c -> c
     | None ->
-	user_err_loc (loc, "decompose_applied_relation",
-		     str"The type" ++ spc () ++ Printer.pr_constr_env env sigma ctype ++
+	user_err ~loc ~hdr:"decompose_applied_relation"
+		    (str"The type" ++ spc () ++ Printer.pr_constr_env env sigma ctype ++
 		       spc () ++ str"of this term does not end with an applied relation.")
 
 (* To add rewriting rules to a base *)
diff --git a/tactics/autorewrite.mli b/tactics/autorewrite.mli
index ac613b57c..49e8588da 100644
--- a/tactics/autorewrite.mli
+++ b/tactics/autorewrite.mli
@@ -6,8 +6,9 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
+(** This files implements the autorewrite tactic. *)
+
 open Term
-open Tacexpr
 open Equality
 
 (** Rewriting rules before tactic interpretation *)
diff --git a/tactics/class_tactics.ml b/tactics/class_tactics.ml
index 0172d28c5..a85afcbf0 100644
--- a/tactics/class_tactics.ml
+++ b/tactics/class_tactics.ml
@@ -6,8 +6,13 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
+(* TODO:
+  - Find an interface allowing eauto to backtrack when shelved goals remain,
+   e.g. to force instantiations.
+ *)
+
 open Pp
-open Errors
+open CErrors
 open Util
 open Names
 open Term
@@ -26,15 +31,27 @@ open Misctypes
 open Proofview.Notations
 open Hints
 
+module NamedDecl = Context.Named.Declaration
+
 (** Hint database named "typeclass_instances", now created directly in Auto *)
 
-let typeclasses_debug = ref false
+(** Options handling *)
+
+let typeclasses_debug = ref 0
 let typeclasses_depth = ref None
 
 let typeclasses_modulo_eta = ref false
 let set_typeclasses_modulo_eta d = (:=) typeclasses_modulo_eta d
 let get_typeclasses_modulo_eta () = !typeclasses_modulo_eta
 
+(** When this flag is enabled, the resolution of type classes tries to avoid
+    useless introductions. This is no longer useful since we have eta, but is
+    here for compatibility purposes. Another compatibility issues is that the
+    cost (in terms of search depth) can differ. *)
+let typeclasses_limit_intros = ref true
+let set_typeclasses_limit_intros d = (:=) typeclasses_limit_intros d
+let get_typeclasses_limit_intros () = !typeclasses_limit_intros
+
 let typeclasses_dependency_order = ref false
 let set_typeclasses_dependency_order d = (:=) typeclasses_dependency_order d
 let get_typeclasses_dependency_order () = !typeclasses_dependency_order
@@ -43,12 +60,41 @@ let typeclasses_iterative_deepening = ref false
 let set_typeclasses_iterative_deepening d = (:=) typeclasses_iterative_deepening d
 let get_typeclasses_iterative_deepening () = !typeclasses_iterative_deepening
 
+(** [typeclasses_filtered_unif] governs the unification algorithm used by type
+    classes. If enabled, a new algorithm based on pattern filtering and refine
+    will be used. When disabled, the previous algorithm based on apply will be
+    used. *)
+let typeclasses_filtered_unification = ref false
+let set_typeclasses_filtered_unification d =
+  (:=) typeclasses_filtered_unification d
+let get_typeclasses_filtered_unification () =
+  !typeclasses_filtered_unification
+
+(** [typeclasses_legacy_resolution] falls back to the 8.5 resolution algorithm,
+    instead of the 8.6 one which uses the native backtracking facilities of the
+    proof engine. *)
+let typeclasses_legacy_resolution = ref false
+let set_typeclasses_legacy_resolution d = (:=) typeclasses_legacy_resolution d
+let get_typeclasses_legacy_resolution () = !typeclasses_legacy_resolution
+
+let set_typeclasses_debug d = (:=) typeclasses_debug (if d then 1 else 0)
+let get_typeclasses_debug () = if !typeclasses_debug > 0 then true else false
+
+let set_typeclasses_verbose =
+  function None -> typeclasses_debug := 0
+         | Some n -> (:=) typeclasses_debug n
+let get_typeclasses_verbose () =
+  if !typeclasses_debug = 0 then None else Some !typeclasses_debug
+
+let set_typeclasses_depth d = (:=) typeclasses_depth d
+let get_typeclasses_depth () = !typeclasses_depth
+
 open Goptions
 
 let _ =
   declare_bool_option
     { optsync  = true;
-      optdepr  = false;
+      optdepr  = true;
       optname  = "do typeclass search modulo eta conversion";
       optkey   = ["Typeclasses";"Modulo";"Eta"];
       optread  = get_typeclasses_modulo_eta;
@@ -58,6 +104,16 @@ let _ =
   declare_bool_option
     { optsync  = true;
       optdepr  = false;
+      optname  = "do typeclass search avoiding eta-expansions " ^
+                   " in proof terms (expensive)";
+      optkey   = ["Typeclasses";"Limit";"Intros"];
+      optread  = get_typeclasses_limit_intros;
+      optwrite = set_typeclasses_limit_intros; }
+
+let _ =
+  declare_bool_option
+    { optsync  = true;
+      optdepr  = false;
       optname  = "during typeclass resolution, solve instances according to their dependency order";
       optkey   = ["Typeclasses";"Dependency";"Order"];
       optread  = get_typeclasses_dependency_order;
@@ -72,42 +128,73 @@ let _ =
       optread  = get_typeclasses_iterative_deepening;
       optwrite = set_typeclasses_iterative_deepening; }
 
-(** We transform the evars that are concerned by this resolution
-    (according to predicate p) into goals.
-    Invariant: function p only manipulates and returns undefined evars *)
+let _ =
+  declare_bool_option
+    { optsync  = true;
+      optdepr  = false;
+      optname  = "compat";
+      optkey   = ["Typeclasses";"Legacy";"Resolution"];
+      optread  = get_typeclasses_legacy_resolution;
+      optwrite = set_typeclasses_legacy_resolution; }
 
-let top_sort evm undefs =
-  let l' = ref [] in
-  let tosee = ref undefs in
-  let rec visit ev evi = 
-    let evs = Evarutil.undefined_evars_of_evar_info evm evi in
-      Evar.Set.iter (fun ev -> 
-	if Evar.Map.mem ev !tosee then 
-	  visit ev (Evar.Map.find ev !tosee)) evs;
-      tosee := Evar.Map.remove ev !tosee;
-      l' := ev :: !l';
-  in
-    while not (Evar.Map.is_empty !tosee) do
-      let ev, evi = Evar.Map.min_binding !tosee in
-	visit ev evi
-    done;
-    List.rev !l'
+let _ =
+  declare_bool_option
+    { optsync  = true;
+      optdepr  = false;
+      optname  = "compat";
+      optkey   = ["Typeclasses";"Filtered";"Unification"];
+      optread  = get_typeclasses_filtered_unification;
+      optwrite = set_typeclasses_filtered_unification; }
 
-let evars_to_goals p evm =
-  let goals = ref Evar.Map.empty in
-  let map ev evi =
-    let evi, goal = p evm ev evi in
-    let () = if goal then goals := Evar.Map.add ev evi !goals in
-    evi
-  in
-  let evm = Evd.raw_map_undefined map evm in
-  if Evar.Map.is_empty !goals then None
-  else Some (!goals, evm)
+let set_typeclasses_debug =
+  declare_bool_option
+    { optsync  = true;
+      optdepr  = false;
+      optname  = "debug output for typeclasses proof search";
+      optkey   = ["Typeclasses";"Debug"];
+      optread  = get_typeclasses_debug;
+      optwrite = set_typeclasses_debug; }
+
+let _ =
+  declare_bool_option
+    { optsync  = true;
+      optdepr  = false;
+      optname  = "debug output for typeclasses proof search";
+      optkey   = ["Debug";"Typeclasses"];
+      optread  = get_typeclasses_debug;
+      optwrite = set_typeclasses_debug; }
+
+let _ =
+  declare_int_option
+    { optsync  = true;
+      optdepr  = false;
+      optname  = "verbosity of debug output for typeclasses proof search";
+      optkey   = ["Typeclasses";"Debug";"Verbosity"];
+      optread  = get_typeclasses_verbose;
+      optwrite = set_typeclasses_verbose; }
+
+let set_typeclasses_depth =
+  declare_int_option
+    { optsync  = true;
+      optdepr  = false;
+      optname  = "depth for typeclasses proof search";
+      optkey   = ["Typeclasses";"Depth"];
+      optread  = get_typeclasses_depth;
+      optwrite = set_typeclasses_depth; }
+
+type search_strategy = Dfs | Bfs
+
+let set_typeclasses_strategy = function
+  | Dfs -> set_typeclasses_iterative_deepening false
+  | Bfs -> set_typeclasses_iterative_deepening true
+
+let pr_ev evs ev =
+  Printer.pr_constr_env (Goal.V82.env evs ev) evs
+                        (Evarutil.nf_evar evs (Goal.V82.concl evs ev))
 
 (** Typeclasses instance search tactic / eauto *)
 
 open Auto
-
 open Unification
 
 let auto_core_unif_flags st freeze = {
@@ -125,7 +212,7 @@ let auto_core_unif_flags st freeze = {
   modulo_eta = !typeclasses_modulo_eta;
 }
 
-let auto_unif_flags freeze st = 
+let auto_unif_flags freeze st =
   let fl = auto_core_unif_flags st freeze in
   { core_unify_flags = fl;
     merge_unify_flags = fl;
@@ -134,25 +221,6 @@ let auto_unif_flags freeze st =
     resolve_evars = false
 }
 
-let rec eq_constr_mod_evars x y =
-  match kind_of_term x, kind_of_term y with
-  | Evar (e1, l1), Evar (e2, l2) when not (Evar.equal e1 e2) -> true
-  | _, _ -> compare_constr eq_constr_mod_evars x y
-
-let progress_evars t =
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
-    let concl = Proofview.Goal.concl gl in
-    let check =
-      Proofview.Goal.nf_enter { enter = begin fun gl' ->
-        let newconcl = Proofview.Goal.concl gl' in
-        if eq_constr_mod_evars concl newconcl
-        then Tacticals.New.tclFAIL 0 (str"No progress made (modulo evars)")
-        else Proofview.tclUNIT ()
-      end }
-    in t <*> check
-  end }
-
-
 let e_give_exact flags poly (c,clenv) gl =
   let (c, _, _) = c in
   let c, gl =
@@ -160,162 +228,347 @@ let e_give_exact flags poly (c,clenv) gl =
       let clenv', subst = Clenv.refresh_undefined_univs clenv in
       let evd = evars_reset_evd ~with_conv_pbs:true gl.sigma clenv'.evd in
       let c = Vars.subst_univs_level_constr subst c in
-	c, {gl with sigma = evd}
+        c, {gl with sigma = evd}
     else c, gl
   in
   let t1 = pf_unsafe_type_of gl c in
   Proofview.V82.of_tactic (Clenvtac.unify ~flags t1 <*> exact_no_check c) gl
 
-let unify_e_resolve poly flags = { enter = begin fun gls (c,clenv) ->
+let unify_e_resolve poly flags = { enter = begin fun gls (c,_,clenv) ->
   let clenv', c = connect_hint_clenv poly c clenv gls in
   let clenv' = Tacmach.New.of_old (clenv_unique_resolver ~flags clenv') gls in
     Clenvtac.clenv_refine true ~with_classes:false clenv'
   end }
 
-let unify_resolve poly flags = { enter = begin fun gls (c,clenv) ->
+let unify_resolve poly flags = { enter = begin fun gls (c,_,clenv) ->
   let clenv', _ = connect_hint_clenv poly c clenv gls in
   let clenv' = Tacmach.New.of_old (clenv_unique_resolver ~flags clenv') gls in
     Clenvtac.clenv_refine false ~with_classes:false clenv'
   end }
 
+(** Application of a lemma using [refine] instead of the old [w_unify] *)
+let unify_resolve_refine poly flags gls ((c, t, ctx),n,clenv) =
+  let open Clenv in
+  let env = Proofview.Goal.env gls in
+  let concl = Proofview.Goal.concl gls in
+  Refine.refine ~unsafe:true { Sigma.run = fun sigma ->
+      let sigma = Sigma.to_evar_map sigma in
+      let sigma, term, ty =
+        if poly then
+          let (subst, ctx) = Universes.fresh_universe_context_set_instance ctx in
+          let map c = Vars.subst_univs_level_constr subst c in
+          let sigma = Evd.merge_context_set Evd.univ_flexible sigma ctx in
+          sigma, map c, map t
+        else
+          let sigma = Evd.merge_context_set Evd.univ_flexible sigma ctx in
+          sigma, c, t
+      in
+      let sigma', cl = Clenv.make_evar_clause env sigma ?len:n ty in
+      let term = applistc term (List.map (fun x -> x.hole_evar) cl.cl_holes) in
+      let sigma' =
+        Evarconv.the_conv_x_leq env ~ts:flags.core_unify_flags.modulo_delta
+                                cl.cl_concl concl sigma'
+      in Sigma.here term (Sigma.Unsafe.of_evar_map sigma') }
+
+let unify_resolve_refine poly flags gl clenv =
+  Proofview.tclORELSE
+    (unify_resolve_refine poly flags gl clenv)
+    (fun ie ->
+      match fst ie with
+      | Evarconv.UnableToUnify _ ->
+         Tacticals.New.tclZEROMSG (str "Unable to unify")
+      | e when CErrors.noncritical e ->
+         Tacticals.New.tclZEROMSG (str "Unexpected error")
+      | _ -> iraise ie)
+
+(** Dealing with goals of the form A -> B and hints of the form
+  C -> A -> B.
+*)
 let clenv_of_prods poly nprods (c, clenv) gl =
   let (c, _, _) = c in
-  if poly || Int.equal nprods 0 then Some clenv
+  if poly || Int.equal nprods 0 then Some (None, clenv)
   else
-    let ty = Tacmach.New.pf_unsafe_type_of gl c in
+    let ty = Retyping.get_type_of (Proofview.Goal.env gl)
+                                  (Sigma.to_evar_map (Proofview.Goal.sigma gl)) c in
     let diff = nb_prod ty - nprods in
-      if Pervasives.(>=) diff 0 then
-        (* Was Some clenv... *)
-	Some (Tacmach.New.of_old (fun gls -> mk_clenv_from_n gls (Some diff) (c,ty)) gl)
-      else None
+    if Pervasives.(>=) diff 0 then
+      (* Was Some clenv... *)
+      Some (Some diff,
+            Tacmach.New.of_old (fun gls -> mk_clenv_from_n gls (Some diff) (c,ty)) gl)
+    else None
 
 let with_prods nprods poly (c, clenv) f =
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
-  match clenv_of_prods poly nprods (c, clenv) gl with
-  | None -> Tacticals.New.tclZEROMSG (str"Not enough premisses")
-  | Some clenv' -> f.enter gl (c, clenv')
-  end }
+  if get_typeclasses_limit_intros () then
+    Proofview.Goal.nf_enter { enter = begin fun gl ->
+      try match clenv_of_prods poly nprods (c, clenv) gl with
+          | None -> Tacticals.New.tclZEROMSG (str"Not enough premisses")
+          | Some (diff, clenv') -> f.enter gl (c, diff, clenv')
+      with e when CErrors.noncritical e ->
+        Tacticals.New.tclZEROMSG (CErrors.print e) end }
+  else Proofview.Goal.nf_enter
+         { enter = begin fun gl ->
+                   if Int.equal nprods 0 then f.enter gl (c, None, clenv)
+                   else Tacticals.New.tclZEROMSG (str"Not enough premisses") end }
+
+let matches_pattern concl pat =
+  let matches env sigma =
+    match pat with
+    | None -> Proofview.tclUNIT ()
+    | Some pat ->
+       let sigma = Sigma.to_evar_map sigma in
+       if Constr_matching.is_matching env sigma pat concl then
+         Proofview.tclUNIT ()
+       else
+         Tacticals.New.tclZEROMSG (str "pattern does not match")
+  in
+   Proofview.Goal.enter { enter = fun gl ->
+     let env = Proofview.Goal.env gl in
+     let sigma = Proofview.Goal.sigma gl in
+       matches env sigma }
+
+(** Semantics of type class resolution lemma application:
+
+  - Use unification to find a well-typed substitution. There might
+    be evars in the goal and the lemma. Evars in the goal can get refined.
+  - Independent evars are turned into goals, whatever their kind is.
+  - Dependent evars of the lemma corresponding to arguments which appear
+    in independent goals or the conclusion are turned into subgoals iff
+    they are of typeclass kind.
+  - The remaining dependent evars not of typeclass type are shelved,
+    and resolution must fill them for it to succeed, otherwise we
+    backtrack.
+ *)
+
+let pr_gls sigma gls =
+  prlist_with_sep spc
+   (fun ev -> int (Evar.repr ev) ++ spc () ++ pr_ev sigma ev) gls
+
+(** Ensure the dependent subgoals are shelved after an apply/eapply. *)
+let shelve_dependencies gls =
+  let open Proofview in
+  tclEVARMAP >>= fun sigma ->
+  (if !typeclasses_debug > 1 && List.length gls > 0 then
+     Feedback.msg_debug (str" shelving dependent subgoals: " ++ pr_gls sigma gls);
+   shelve_goals gls)
+
+let hintmap_of hdc secvars concl =
+  match hdc with
+  | None -> fun db -> Hint_db.map_none secvars db
+  | Some hdc ->
+     fun db ->
+     if Hint_db.use_dn db then (* Using dnet *)
+       Hint_db.map_eauto secvars hdc concl db
+     else Hint_db.map_existential secvars hdc concl db
 
 (** Hack to properly solve dependent evars that are typeclasses *)
-
-let rec e_trivial_fail_db db_list local_db goal =
+let rec e_trivial_fail_db only_classes db_list local_db secvars =
+  let open Tacticals.New in
+  let open Tacmach.New in
+  let trivial_fail =
+    Proofview.Goal.nf_enter { enter =
+    begin fun gl ->
+    let env = Proofview.Goal.env gl in
+    let sigma = Tacmach.New.project gl in
+    let d = pf_last_hyp gl in
+    let hintl = make_resolve_hyp env sigma d in
+    let hints = Hint_db.add_list env sigma hintl local_db in
+      e_trivial_fail_db only_classes db_list hints secvars
+      end }
+  in
+  let trivial_resolve =
+    Proofview.Goal.nf_enter { enter =
+    begin fun gl ->
+    let tacs = e_trivial_resolve db_list local_db secvars only_classes
+                                 (project gl) (pf_concl gl) in
+      tclFIRST (List.map (fun (x,_,_,_,_) -> x) tacs)
+    end}
+  in
   let tacl =
-    Proofview.V82.of_tactic Eauto.registered_e_assumption ::
-    (tclTHEN (Proofview.V82.of_tactic Tactics.intro)
-       (function g'->
-	  let d = pf_last_hyp g' in
-	  let hintl = make_resolve_hyp (pf_env g') (project g') d in
-          (e_trivial_fail_db db_list
-	      (Hint_db.add_list (pf_env g') (project g') hintl local_db) g'))) ::
-    (List.map (fun (x,_,_,_,_) -> x) 
-     (e_trivial_resolve db_list local_db (project goal) (pf_concl goal)))
+    Eauto.registered_e_assumption ::
+    (tclTHEN Tactics.intro trivial_fail :: [trivial_resolve])
   in
-  tclFIRST (List.map tclCOMPLETE tacl) goal
+  tclFIRST (List.map tclCOMPLETE tacl)
 
-and e_my_find_search db_list local_db hdc complete sigma concl =
+and e_my_find_search db_list local_db secvars hdc complete only_classes sigma concl =
+  let open Proofview.Notations in
   let prods, concl = decompose_prod_assum concl in
   let nprods = List.length prods in
-  let freeze = 
+  let freeze =
     try
-      let cl = Typeclasses.class_info (fst hdc) in
-	if cl.cl_strict then
-	  Evd.evars_of_term concl
-	else Evar.Set.empty
-    with e when Errors.noncritical e -> Evar.Set.empty
+      match hdc with
+      | Some (hd,_) when only_classes ->
+         let cl = Typeclasses.class_info hd in
+         if cl.cl_strict then
+           Evd.evars_of_term concl
+         else Evar.Set.empty
+      | _ -> Evar.Set.empty
+    with e when CErrors.noncritical e -> Evar.Set.empty
   in
+  let hint_of_db = hintmap_of hdc secvars concl in
   let hintl =
     List.map_append
       (fun db ->
-	let tacs = 
-	  if Hint_db.use_dn db then (* Using dnet *)
-	    Hint_db.map_eauto hdc concl db
-	  else Hint_db.map_existential hdc concl db
-	in
-	let flags = auto_unif_flags freeze (Hint_db.transparent_state db) in
-	  List.map (fun x -> (flags, x)) tacs)
+        let tacs = hint_of_db db in
+        let flags = auto_unif_flags freeze (Hint_db.transparent_state db) in
+          List.map (fun x -> (flags, x)) tacs)
       (local_db::db_list)
   in
   let tac_of_hint =
-    fun (flags, {pri = b; pat = p; poly = poly; code = t; name = name}) ->
+    fun (flags, {pri = b; pat = p; poly = poly; code = t; secvars; name = name}) ->
       let tac = function
-      | Res_pf (term,cl) -> with_prods nprods poly (term,cl) (unify_resolve poly flags)
-      | ERes_pf (term,cl) -> with_prods nprods poly (term,cl) (unify_e_resolve poly flags)
-      | Give_exact c -> Proofview.V82.tactic (e_give_exact flags poly c)
+        | Res_pf (term,cl) ->
+           if get_typeclasses_filtered_unification () then
+             let tac =
+               with_prods nprods poly (term,cl)
+                          ({ enter = fun gl clenv ->
+                             matches_pattern concl p <*>
+                               unify_resolve_refine poly flags gl clenv})
+             in Tacticals.New.tclTHEN tac Proofview.shelve_unifiable
+           else
+             let tac =
+               with_prods nprods poly (term,cl) (unify_resolve poly flags) in
+             if get_typeclasses_legacy_resolution () then
+               Tacticals.New.tclTHEN tac Proofview.shelve_unifiable
+             else
+               Proofview.tclBIND (Proofview.with_shelf tac)
+                  (fun (gls, ()) -> shelve_dependencies gls)
+        | ERes_pf (term,cl) ->
+           if get_typeclasses_filtered_unification () then
+             let tac = (with_prods nprods poly (term,cl)
+                  ({ enter = fun gl clenv ->
+                             matches_pattern concl p <*>
+                             unify_resolve_refine poly flags gl clenv})) in
+             Tacticals.New.tclTHEN tac Proofview.shelve_unifiable
+           else
+             let tac =
+               with_prods nprods poly (term,cl) (unify_e_resolve poly flags) in
+             if get_typeclasses_legacy_resolution () then
+               Tacticals.New.tclTHEN tac Proofview.shelve_unifiable
+             else
+               Proofview.tclBIND (Proofview.with_shelf tac)
+                  (fun (gls, ()) -> shelve_dependencies gls)
+        | Give_exact (c,clenv) ->
+           if get_typeclasses_filtered_unification () then
+             let tac =
+               matches_pattern concl p <*>
+                 Proofview.Goal.nf_enter
+                   { enter = fun gl -> unify_resolve_refine poly flags gl (c,None,clenv) } in
+             Tacticals.New.tclTHEN tac Proofview.shelve_unifiable
+           else
+             Proofview.V82.tactic (e_give_exact flags poly (c,clenv))
       | Res_pf_THEN_trivial_fail (term,cl) ->
-         Proofview.V82.tactic (tclTHEN
-				 (Proofview.V82.of_tactic ((with_prods nprods poly (term,cl) (unify_e_resolve poly flags))))
-				 (if complete then tclIDTAC else e_trivial_fail_db db_list local_db))
-      | Unfold_nth c -> Proofview.V82.tactic (tclWEAK_PROGRESS (Proofview.V82.of_tactic (unfold_in_concl [AllOccurrences,c])))
+         let fst = with_prods nprods poly (term,cl) (unify_e_resolve poly flags) in
+         let snd = if complete then Tacticals.New.tclIDTAC
+                   else e_trivial_fail_db only_classes db_list local_db secvars in
+         Tacticals.New.tclTHEN fst snd
+      | Unfold_nth c ->
+         let tac = Proofview.V82.of_tactic (unfold_in_concl [AllOccurrences,c]) in
+         Proofview.V82.tactic (tclWEAK_PROGRESS tac)
       | Extern tacast -> conclPattern concl p tacast
       in
-      let tac = Proofview.V82.of_tactic (run_hint t tac) in
-      let tac = if complete then tclCOMPLETE tac else tac in
-	match repr_hint t with
-	| Extern _ -> (tac,b,true, name, lazy (pr_hint t))
-	| _ ->
-(* 	  let tac gl = with_pattern (pf_env gl) (project gl) flags p concl tac gl in *)
-	    (tac,b,false, name, lazy (pr_hint t))
+      let tac = run_hint t tac in
+      let tac = if complete then Tacticals.New.tclCOMPLETE tac else tac in
+      let pp =
+        match p with
+        | Some pat when get_typeclasses_filtered_unification () ->
+           str " with pattern " ++ Printer.pr_constr_pattern pat
+        | _ -> mt ()
+      in
+        match repr_hint t with
+        | Extern _ -> (tac, b, true, name, lazy (pr_hint t ++ pp))
+        | _ -> (tac, b, false, name, lazy (pr_hint t ++ pp))
   in List.map tac_of_hint hintl
 
-and e_trivial_resolve db_list local_db sigma concl =
+and e_trivial_resolve db_list local_db secvars only_classes sigma concl =
+  let hd = try Some (decompose_app_bound concl) with Bound -> None in
   try
-    e_my_find_search db_list local_db
-     (decompose_app_bound concl) true sigma concl
-  with Bound | Not_found -> []
+    e_my_find_search db_list local_db secvars hd true only_classes sigma concl
+  with Not_found -> []
 
-let e_possible_resolve db_list local_db sigma concl =
+let e_possible_resolve db_list local_db secvars only_classes sigma concl =
+  let hd = try Some (decompose_app_bound concl) with Bound -> None in
   try
-    e_my_find_search db_list local_db
-      (decompose_app_bound concl) false sigma concl
-  with Bound | Not_found -> []
+    e_my_find_search db_list local_db secvars hd false only_classes sigma concl
+  with Not_found -> []
+
+let cut_of_hints h =
+  List.fold_left (fun cut db -> PathOr (Hint_db.cut db, cut)) PathEmpty h
 
 let catchable = function
   | Refiner.FailError _ -> true
   | e -> Logic.catchable_exception e
 
-let pr_ev evs ev = Printer.pr_constr_env (Goal.V82.env evs ev) evs (Evarutil.nf_evar evs (Goal.V82.concl evs ev))
+(* alternate separators in debug search path output *)
+let debug_seps = [| "." ; "-" |]
+let next_sep seps = 
+  let num_seps = Array.length seps in
+  let sep_index = ref 0 in
+  fun () ->
+    let sep = seps.(!sep_index) in
+    sep_index := (!sep_index + 1) mod num_seps;
+    str sep
+let pr_depth l = prlist_with_sep (next_sep debug_seps) int (List.rev l)
 
-let pr_depth l = prlist_with_sep (fun () -> str ".") int (List.rev l)
-
-type autoinfo = { hints : hint_db; is_evar: existential_key option;
-		  only_classes: bool; unique : bool;
-		  auto_depth: int list; auto_last_tac: std_ppcmds Lazy.t;
-		  auto_path : global_reference option list;
-		  auto_cut : hints_path }
-type autogoal = goal * autoinfo
-type failure = NotApplicable | ReachedLimit
-type 'ans fk = failure -> 'ans
-type ('a,'ans) sk = 'a -> 'ans fk -> 'ans
-type 'a tac = { skft : 'ans. ('a,'ans) sk -> 'ans fk -> autogoal sigma -> 'ans }
-
-type auto_result = autogoal list sigma
+let is_Prop env sigma concl =
+  let ty = Retyping.get_type_of env sigma concl in
+  match kind_of_term ty with
+  | Sort (Prop Null) -> true
+  | _ -> false
 
-type atac = auto_result tac
+let is_unique env concl =
+  try
+    let (cl,u), args = dest_class_app env concl in
+    cl.cl_unique
+  with e when CErrors.noncritical e -> false
 
-(* Some utility types to avoid the need of -rectypes *)
+(** Sort the undefined variables from the least-dependent to most dependent. *)
+let top_sort evm undefs =
+  let l' = ref [] in
+  let tosee = ref undefs in
+  let rec visit ev evi =
+    let evs = Evarutil.undefined_evars_of_evar_info evm evi in
+      Evar.Set.iter (fun ev ->
+        if Evar.Map.mem ev !tosee then
+          visit ev (Evar.Map.find ev !tosee)) evs;
+      tosee := Evar.Map.remove ev !tosee;
+      l' := ev :: !l';
+  in
+    while not (Evar.Map.is_empty !tosee) do
+      let ev, evi = Evar.Map.min_binding !tosee in
+        visit ev evi
+    done;
+    List.rev !l'
 
-type 'a optionk =
-  | Nonek
-  | Somek of 'a * 'a optionk fk
+(** We transform the evars that are concerned by this resolution
+    (according to predicate p) into goals.
+    Invariant: function p only manipulates and returns undefined evars
+*)
 
-type ('a,'b) optionk2 =
-  | Nonek2 of failure
-  | Somek2 of 'a * 'b * ('a,'b) optionk2 fk
+let evars_to_goals p evm =
+  let goals = ref Evar.Map.empty in
+  let map ev evi =
+    let evi, goal = p evm ev evi in
+    let () = if goal then goals := Evar.Map.add ev evi !goals in
+    evi
+  in
+  let evm = Evd.raw_map_undefined map evm in
+  if Evar.Map.is_empty !goals then None
+  else Some (!goals, evm)
 
+(** Making local hints  *)
 let make_resolve_hyp env sigma st flags only_classes pri decl =
-  let open Context.Named.Declaration in
-  let id = get_id decl in
-  let cty = Evarutil.nf_evar sigma (get_type decl) in
+  let id = NamedDecl.get_id decl in
+  let cty = Evarutil.nf_evar sigma (NamedDecl.get_type decl) in
   let rec iscl env ty =
     let ctx, ar = decompose_prod_assum ty in
       match kind_of_term (fst (decompose_app ar)) with
       | Const (c,_) -> is_class (ConstRef c)
       | Ind (i,_) -> is_class (IndRef i)
       | _ ->
-	  let env' = Environ.push_rel_context ctx env in
-	  let ty' = whd_betadeltaiota env' ar in
-	       if not (Term.eq_constr ty' ar) then iscl env' ty'
-	       else false
+          let env' = Environ.push_rel_context ctx env in
+          let ty' = whd_all env' ar in
+               if not (Term.eq_constr ty' ar) then iscl env' ty'
+               else false
   in
   let is_class = iscl env cty in
   let keep = not only_classes || is_class in
@@ -323,344 +576,831 @@ let make_resolve_hyp env sigma st flags only_classes pri decl =
       let c = mkVar id in
       let name = PathHints [VarRef id] in
       let hints =
-	if is_class then
-	  let hints = build_subclasses ~check:false env sigma (VarRef id) None in
-	    (List.map_append
-	       (fun (path,pri, c) -> make_resolves env sigma ~name:(PathHints path)
-		  (true,false,Flags.is_verbose()) pri false
-		 (IsConstr (c,Univ.ContextSet.empty)))
-	       hints)
-	else []
+        if is_class then
+          let hints = build_subclasses ~check:false env sigma (VarRef id) empty_hint_info in
+            (List.map_append
+             (fun (path,info,c) ->
+	      let info =
+		{ info with Vernacexpr.hint_pattern =
+			    Option.map (Constrintern.intern_constr_pattern env)
+				       info.Vernacexpr.hint_pattern }
+	      in
+	      make_resolves env sigma ~name:(PathHints path)
+                  (true,false,Flags.is_verbose()) info false
+                 (IsConstr (c,Univ.ContextSet.empty)))
+               hints)
+        else []
       in
         (hints @ List.map_filter
-	 (fun f -> try Some (f (c, cty, Univ.ContextSet.empty)) 
-	   with Failure _ | UserError _ -> None)
-	 [make_exact_entry ~name env sigma pri false; 
-	  make_apply_entry ~name env sigma flags pri false])
+         (fun f -> try Some (f (c, cty, Univ.ContextSet.empty))
+           with Failure _ | UserError _ -> None)
+         [make_exact_entry ~name env sigma pri false;
+          make_apply_entry ~name env sigma flags pri false])
     else []
 
-let pf_filtered_hyps gls =
-  Goal.V82.hyps gls.Evd.sigma (sig_it gls)
-
 let make_hints g st only_classes sign =
-  let paths, hintlist =
+  let hintlist =
     List.fold_left
-    (fun (paths, hints) hyp ->
-      let consider =
-        let open Context.Named.Declaration in
-	try let t = Global.lookup_named (get_id hyp) |> get_type in
-	      (* Section variable, reindex only if the type changed *)
-	      not (Term.eq_constr t (get_type hyp))
-	with Not_found -> true
-     in
-      if consider then 
-	let path, hint =
-	  PathEmpty, pf_apply make_resolve_hyp g st (true,false,false) only_classes None hyp
-	in
-	  (PathOr (paths, path), hint @ hints)
-      else (paths, hints))
-    (PathEmpty, []) sign
+      (fun hints hyp ->
+        let consider =
+          try let t = hyp |> NamedDecl.get_id |> Global.lookup_named |> NamedDecl.get_type in
+              (* Section variable, reindex only if the type changed *)
+              not (Term.eq_constr t (NamedDecl.get_type hyp))
+          with Not_found -> true
+        in
+        if consider then
+          let hint =
+            pf_apply make_resolve_hyp g st (true,false,false) only_classes empty_hint_info hyp
+          in hint @ hints
+        else hints)
+      ([]) sign
   in Hint_db.add_list (pf_env g) (project g) hintlist (Hint_db.empty st true)
 
-let make_autogoal_hints =
-  let cache = ref (true, Environ.empty_named_context_val, 
-		   Hint_db.empty full_transparent_state true) 
-  in
-    fun only_classes ?(st=full_transparent_state) g ->
-      let sign = pf_filtered_hyps g in
-      let (onlyc, sign', cached_hints) = !cache in
-	if onlyc == only_classes && 
-	  (sign == sign' || Environ.eq_named_context_val sign sign') 
-	  && Hint_db.transparent_state cached_hints == st
-	then
-	  cached_hints
-	else
-	  let hints = make_hints g st only_classes (Environ.named_context_of_val sign) in
-	    cache := (only_classes, sign, hints); hints
-
-let lift_tactic tac (f : goal list sigma -> autoinfo -> autogoal list sigma) : 'a tac =
-  { skft = fun sk fk {it = gl,hints; sigma=s;} ->
-    let res = try Some (tac {it=gl; sigma=s;})
-              with e when catchable e -> None in
-      match res with
-      | Some gls -> sk (f gls hints) fk
-      | None -> fk NotApplicable }
-
-let intro_tac : atac =
-  lift_tactic (Proofview.V82.of_tactic Tactics.intro)
-    (fun {it = gls; sigma = s} info ->
-      let gls' =
-	List.map (fun g' ->
-	  let env = Goal.V82.env s g' in
-	  let context = Environ.named_context_of_val (Goal.V82.hyps s g') in
-	  let hint = make_resolve_hyp env s (Hint_db.transparent_state info.hints)
-	    (true,false,false) info.only_classes None (List.hd context) in
-	  let ldb = Hint_db.add_list env s hint info.hints in
-	    (g', { info with is_evar = None; hints = ldb; auto_last_tac = lazy (str"intro") })) gls
-      in {it = gls'; sigma = s;})
-
-let normevars_tac : atac =
-  { skft = fun sk fk {it = (gl, info); sigma = s;} ->
-    let gl', sigma' = Goal.V82.nf_evar s gl in
-    let info' = { info with auto_last_tac = lazy (str"normevars") } in
-      sk {it = [gl', info']; sigma = sigma';} fk }
-
-let merge_failures x y =
-  match x, y with
-  | _, ReachedLimit
-  | ReachedLimit, _ -> ReachedLimit
-  | NotApplicable, NotApplicable -> NotApplicable
-
-let or_tac (x : 'a tac) (y : 'a tac) : 'a tac =
-  { skft = fun sk fk gls -> x.skft sk
-    (fun f -> y.skft sk (fun f' -> fk (merge_failures f f')) gls) gls }
-
-let or_else_tac (x : 'a tac) (y : failure -> 'a tac) : 'a tac =
-  { skft = fun sk fk gls -> x.skft sk
-    (fun f -> (y f).skft sk fk gls) gls }
+(** <= 8.5 resolution *)
+module V85 = struct
 
-let is_Prop env sigma concl =
-  let ty = Retyping.get_type_of env sigma concl in
-  match kind_of_term ty with
-  | Sort (Prop Null) -> true
-  | _ -> false
+  type autoinfo = { hints : hint_db; is_evar: existential_key option;
+                    only_classes: bool; unique : bool;
+                    auto_depth: int list; auto_last_tac: std_ppcmds Lazy.t;
+                    auto_path : global_reference option list;
+                    auto_cut : hints_path }
+  type autogoal = goal * autoinfo
+  type failure = NotApplicable | ReachedLimit
+  type 'ans fk = failure -> 'ans
+  type ('a,'ans) sk = 'a -> 'ans fk -> 'ans
+  type 'a tac = { skft : 'ans. ('a,'ans) sk -> 'ans fk -> autogoal sigma -> 'ans }
 
-let is_unique env concl = 
-  try 
-    let (cl,u), args = dest_class_app env concl in
-      cl.cl_unique
-  with e when Errors.noncritical e -> false
-
-let needs_backtrack env evd oev concl =
-  if Option.is_empty oev || is_Prop env evd concl then
-    occur_existential concl
-  else true
-
-let hints_tac hints =
-  { skft = fun sk fk {it = gl,info; sigma = s;} ->
-      let env = Goal.V82.env s gl in
-      let concl = Goal.V82.concl s gl in
-      let tacgl = {it = gl; sigma = s;} in
-      let poss = e_possible_resolve hints info.hints s concl in
-      let unique = is_unique env concl in
-      let rec aux i foundone = function
-      | (tac, _, b, name, pp) :: tl ->
-	let derivs = path_derivate info.auto_cut name in
-	let res =
-          try
-	    if path_matches derivs [] then None else Some (tac tacgl)
-	  with e when catchable e -> None
-	in
-	  (match res with
-	  | None -> aux i foundone tl
-	  | Some {it = gls; sigma = s';} ->
-	    if !typeclasses_debug then
-	      Feedback.msg_debug (pr_depth (i :: info.auto_depth) ++ str": " ++ Lazy.force pp
-			 ++ str" on" ++ spc () ++ pr_ev s gl);
-	    let sgls =
-	      evars_to_goals
-		(fun evm ev evi ->
-		  if Typeclasses.is_resolvable evi && not (Evd.is_undefined s ev) &&
-		    (not info.only_classes || Typeclasses.is_class_evar evm evi)
-		  then Typeclasses.mark_unresolvable evi, true
-		  else evi, false) s'
-	    in
-	    let newgls, s' =
-	      let gls' = List.map (fun g -> (None, g)) gls in
-		match sgls with
-		| None -> gls', s'
-		| Some (evgls, s') ->
-		  if not !typeclasses_dependency_order then
-		    (gls' @ List.map (fun (ev,_) -> (Some ev, ev)) (Evar.Map.bindings evgls), s')
-		  else 
- 		    (* Reorder with dependent subgoals. *)
-		    let evm = List.fold_left 
-		      (fun acc g -> Evar.Map.add g (Evd.find_undefined s' g) acc) evgls gls in
-		    let gls = top_sort s' evm in
-		      (List.map (fun ev -> Some ev, ev) gls, s')
-	    in
-	    let gls' = List.map_i
-	      (fun j (evar, g) ->
-		let info =
-		  { info with auto_depth = j :: i :: info.auto_depth; auto_last_tac = pp;
-		    is_evar = evar;
-		    hints =
-		      if b && not (Environ.eq_named_context_val (Goal.V82.hyps s' g) 
-				     (Goal.V82.hyps s' gl))
-		      then make_autogoal_hints info.only_classes
-			~st:(Hint_db.transparent_state info.hints) {it = g; sigma = s';}
-		      else info.hints;
-		    auto_cut = derivs }
-		in g, info) 1 newgls in
-	    let glsv = {it = gls'; sigma = s';} in
-	    let fk' =
-	      (fun e ->
-		let do_backtrack =
-		  if unique then occur_existential concl
-		  else if info.unique then true
-		  else if List.is_empty gls' then 
-		    needs_backtrack env s' info.is_evar concl
-		  else true
-		in
-		let e' = match foundone with None -> e | Some e' -> merge_failures e e' in
-		  if !typeclasses_debug then
-		    Feedback.msg_debug 
-		      ((if do_backtrack then str"Backtracking after "
-			else str "Not backtracking after ")
-		       ++ Lazy.force pp);
-		  if do_backtrack then aux (succ i) (Some e') tl
-		  else fk e')
-	    in
-	      sk glsv fk')
-      | [] ->
-	if foundone == None && !typeclasses_debug then
-	  Feedback.msg_debug (pr_depth info.auto_depth ++ str": no match for " ++
-		       Printer.pr_constr_env (Goal.V82.env s gl) s concl ++
-		       spc () ++ str ", " ++ int (List.length poss) ++ str" possibilities");
-	match foundone with
-	| Some e -> fk e
-	| None -> fk NotApplicable
-      in aux 1 None poss }
-
-let then_list (second : atac) (sk : (auto_result, 'a) sk) : (auto_result, 'a) sk =
-  let rec aux s (acc : autogoal list list) fk = function
-    | (gl,info) :: gls ->
-        Control.check_for_interrupt ();
-	(match info.is_evar with
-	 | Some ev when Evd.is_defined s ev -> aux s acc fk gls
-	 | _ ->
-	     second.skft
-	       (fun {it=gls';sigma=s'} fk' -> 
-		 let fk'' =
-		   if not info.unique && List.is_empty gls' &&
-		     not (needs_backtrack (Goal.V82.env s gl) s
-			    info.is_evar (Goal.V82.concl s gl))
-		   then fk
-		   else fk'
-		 in
-		   aux s' (gls'::acc) fk'' gls)
-	       fk {it = (gl,info); sigma = s; })
-    | [] -> Somek2 (List.rev acc, s, fk)
-  in fun {it = gls; sigma = s; } fk ->
-    let rec aux' = function
-      | Nonek2 e -> fk e
-      | Somek2 (res, s', fk') ->
-	  let goals' = List.concat res in
-	    sk {it = goals'; sigma = s'; } (fun e -> aux' (fk' e))
-    in aux' (aux s [] (fun e -> Nonek2 e) gls)
-
-let then_tac (first : atac) (second : atac) : atac =
-  { skft = fun sk fk -> first.skft (then_list second sk) fk }
-
-let run_tac (t : 'a tac) (gl : autogoal sigma) : auto_result option =
-  t.skft (fun x _ -> Some x) (fun _ -> None) gl
-
-type run_list_res = auto_result optionk
-
-let run_list_tac (t : 'a tac) p goals (gl : autogoal list sigma) : run_list_res =
-  (then_list t (fun x fk -> Somek (x, fk)))
-    gl
-    (fun _ -> Nonek)
-
-let fail_tac reason : atac =
-  { skft = fun sk fk _ -> fk reason }
-
-let rec fix (t : 'a tac) : 'a tac =
-  then_tac t { skft = fun sk fk -> (fix t).skft sk fk }
-
-let rec fix_limit limit (t : 'a tac) : 'a tac =
-  if Int.equal limit 0 then fail_tac ReachedLimit
-  else then_tac t { skft = fun sk fk -> (fix_limit (pred limit) t).skft sk fk }
-
-let fix_iterative t =
-  let rec aux depth =
-    or_else_tac (fix_limit depth t)
-      (function 
-	| NotApplicable as e -> fail_tac e
-	| ReachedLimit -> aux (succ depth))
-  in aux 1
-
-let fix_iterative_limit limit (t : 'a tac) : 'a tac =
-  let rec aux depth =
-    if Int.equal depth limit then fail_tac ReachedLimit
-    else or_tac (fix_limit depth t) { skft = fun sk fk -> (aux (succ depth)).skft sk fk }
-  in aux 1
-
-let make_autogoal ?(only_classes=true) ?(unique=false) ?(st=full_transparent_state) cut ev g =
-  let hints = make_autogoal_hints only_classes ~st g in
-    (g.it, { hints = hints ; is_evar = ev; unique = unique;
-	     only_classes = only_classes; auto_depth = []; auto_last_tac = lazy (str"none");
-	     auto_path = []; auto_cut = cut })
+  type auto_result = autogoal list sigma
 
+  type atac = auto_result tac
 
-let cut_of_hints h =
-  List.fold_left (fun cut db -> PathOr (Hint_db.cut db, cut)) PathEmpty h
+  (* Some utility types to avoid the need of -rectypes *)
 
-let make_autogoals ?(only_classes=true) ?(unique=false) 
-    ?(st=full_transparent_state) hints gs evm' =
-  let cut = cut_of_hints hints in
-  { it = List.map_i (fun i g ->
-    let (gl, auto) = make_autogoal ~only_classes ~unique 
-      ~st cut (Some g) {it = g; sigma = evm'; } in
-      (gl, { auto with auto_depth = [i]})) 1 gs; sigma = evm'; }
-
-let get_result r =
-  match r with
-  | Nonek -> None
-  | Somek (gls, fk) -> Some (gls.sigma,fk)
-
-let run_on_evars ?(only_classes=true) ?(unique=false) ?(st=full_transparent_state) p evm hints tac =
-  match evars_to_goals p evm with
-  | None -> None (* This happens only because there's no evar having p *)
-  | Some (goals, evm') ->
-    let goals = 
-      if !typeclasses_dependency_order then
-	top_sort evm' goals
-      else List.map (fun (ev, _) -> ev) (Evar.Map.bindings goals)
+  type 'a optionk =
+    | Nonek
+    | Somek of 'a * 'a optionk fk
+
+  type ('a,'b) optionk2 =
+    | Nonek2 of failure
+    | Somek2 of 'a * 'b * ('a,'b) optionk2 fk
+
+  let pf_filtered_hyps gls =
+    Goal.V82.hyps gls.Evd.sigma (sig_it gls)
+
+  let make_autogoal_hints =
+    let cache = ref (true, Environ.empty_named_context_val,
+                     Hint_db.empty full_transparent_state true)
     in
-    let res = run_list_tac tac p goals 
-      (make_autogoals ~only_classes ~unique ~st hints goals evm') in
-      match get_result res with
-      | None -> raise Not_found
-      | Some (evm', fk) -> 
-	Some (evars_reset_evd ~with_conv_pbs:true ~with_univs:false evm' evm, fk)
-
-let eauto_tac hints =
-  then_tac normevars_tac (or_tac (hints_tac hints) intro_tac)
-
-let eauto_tac ?limit hints =
-  if get_typeclasses_iterative_deepening () then
-    match limit with
-    | None -> fix_iterative (eauto_tac hints)
-    | Some limit -> fix_iterative_limit limit (eauto_tac hints)
-  else
-    match limit with
-    | None -> fix (eauto_tac hints)
-    | Some limit -> fix_limit limit (eauto_tac hints)
+    fun only_classes ?(st=full_transparent_state) g ->
+    let sign = pf_filtered_hyps g in
+    let (onlyc, sign', cached_hints) = !cache in
+    if onlyc == only_classes &&
+         (sign == sign' || Environ.eq_named_context_val sign sign')
+         && Hint_db.transparent_state cached_hints == st
+    then
+      cached_hints
+    else
+      let hints = make_hints g st only_classes (Environ.named_context_of_val sign)
+      in
+      cache := (only_classes, sign, hints); hints
+
+  let lift_tactic tac (f : goal list sigma -> autoinfo -> autogoal list sigma) : 'a tac =
+    { skft = fun sk fk {it = gl,hints; sigma=s;} ->
+             let res = try Some (tac {it=gl; sigma=s;})
+                       with e when catchable e -> None in
+             match res with
+             | Some gls -> sk (f gls hints) fk
+             | None -> fk NotApplicable }
+
+  let intro_tac : atac =
+    let tac {it = gls; sigma = s} info =
+      let gls' =
+        List.map (fun g' ->
+            let env = Goal.V82.env s g' in
+            let context = Environ.named_context_of_val (Goal.V82.hyps s g') in
+            let hint = make_resolve_hyp env s (Hint_db.transparent_state info.hints)
+              (true,false,false) info.only_classes empty_hint_info (List.hd context) in
+            let ldb = Hint_db.add_list env s hint info.hints in
+            (g', { info with is_evar = None; hints = ldb;
+                             auto_last_tac = lazy (str"intro") })) gls
+      in {it = gls'; sigma = s;}
+    in
+    lift_tactic (Proofview.V82.of_tactic Tactics.intro) tac
+
+  let normevars_tac : atac =
+    { skft = fun sk fk {it = (gl, info); sigma = s;} ->
+             let gl', sigma' = Goal.V82.nf_evar s gl in
+             let info' = { info with auto_last_tac = lazy (str"normevars") } in
+             sk {it = [gl', info']; sigma = sigma';} fk }
+
+  let merge_failures x y =
+    match x, y with
+    | _, ReachedLimit
+      | ReachedLimit, _ -> ReachedLimit
+    | NotApplicable, NotApplicable -> NotApplicable
+
+  let or_tac (x : 'a tac) (y : 'a tac) : 'a tac =
+    { skft = fun sk fk gls -> x.skft sk
+      (fun f -> y.skft sk (fun f' -> fk (merge_failures f f')) gls) gls }
+
+  let or_else_tac (x : 'a tac) (y : failure -> 'a tac) : 'a tac =
+    { skft = fun sk fk gls -> x.skft sk
+      (fun f -> (y f).skft sk fk gls) gls }
+
+  let needs_backtrack env evd oev concl =
+    if Option.is_empty oev || is_Prop env evd concl then
+      occur_existential concl
+    else true
 
-let real_eauto ?limit unique st hints p evd =
-  let res =
-    run_on_evars ~st ~unique p evd hints (eauto_tac ?limit hints)
-  in
+  let hints_tac hints sk fk {it = gl,info; sigma = s} =
+    let env = Goal.V82.env s gl in
+    let concl = Goal.V82.concl s gl in
+    let tacgl = {it = gl; sigma = s;} in
+    let secvars = secvars_of_hyps (Environ.named_context_of_val (Goal.V82.hyps s gl)) in
+    let poss = e_possible_resolve hints info.hints secvars info.only_classes s concl in
+    let unique = is_unique env concl in
+    let rec aux i foundone = function
+      | (tac, _, extern, name, pp) :: tl ->
+         let derivs = path_derivate info.auto_cut name in
+         let res =
+           try
+             if path_matches derivs [] then None
+             else Some (Proofview.V82.of_tactic tac tacgl)
+           with e when catchable e -> None
+         in
+         (match res with
+          | None -> aux i foundone tl
+          | Some {it = gls; sigma = s';} ->
+             if !typeclasses_debug > 0 then
+               Feedback.msg_debug
+                 (pr_depth (i :: info.auto_depth) ++ str": " ++ Lazy.force pp
+                  ++ str" on" ++ spc () ++ pr_ev s gl);
+             let sgls =
+               evars_to_goals
+                 (fun evm ev evi ->
+                   if Typeclasses.is_resolvable evi && not (Evd.is_undefined s ev) &&
+                        (not info.only_classes || Typeclasses.is_class_evar evm evi)
+                   then Typeclasses.mark_unresolvable evi, true
+                   else evi, false) s'
+             in
+             let newgls, s' =
+               let gls' = List.map (fun g -> (None, g)) gls in
+               match sgls with
+               | None -> gls', s'
+               | Some (evgls, s') ->
+                  if not !typeclasses_dependency_order then
+                    (gls' @ List.map (fun (ev,_) -> (Some ev, ev)) (Evar.Map.bindings evgls), s')
+                  else
+                    (* Reorder with dependent subgoals. *)
+                    let evm = List.fold_left
+                                (fun acc g -> Evar.Map.add g (Evd.find_undefined s' g) acc) evgls gls in
+                    let gls = top_sort s' evm in
+                    (List.map (fun ev -> Some ev, ev) gls, s')
+             in
+             let reindex g =
+               let open Goal.V82 in
+               extern && not (Environ.eq_named_context_val
+                             (hyps s' g) (hyps s' gl))
+             in
+             let gl' j (evar, g) =
+               let hints' =
+                 if reindex g then
+                   make_autogoal_hints
+                     info.only_classes
+                     ~st:(Hint_db.transparent_state info.hints)
+                     {it = g; sigma = s';}
+                 else info.hints
+               in
+               { info with
+                 auto_depth = j :: i :: info.auto_depth;
+                 auto_last_tac = pp;
+                 is_evar = evar;
+                 hints = hints';
+                 auto_cut = derivs }
+             in
+             let gls' = List.map_i (fun i g -> snd g, gl' i g) 1 newgls in
+             let glsv = {it = gls'; sigma = s';} in
+             let fk' =
+               (fun e ->
+                 let do_backtrack =
+                   if unique then occur_existential concl
+                   else if info.unique then true
+                   else if List.is_empty gls' then
+                     needs_backtrack env s' info.is_evar concl
+                   else true
+                 in
+                 let e' = match foundone with None -> e
+                                            | Some e' -> merge_failures e e' in
+                 if !typeclasses_debug > 0 then
+                   Feedback.msg_debug
+                     ((if do_backtrack then str"Backtracking after "
+                       else str "Not backtracking after ")
+                      ++ Lazy.force pp);
+                 if do_backtrack then aux (succ i) (Some e') tl
+                 else fk e')
+             in
+             sk glsv fk')
+      | [] ->
+         if foundone == None && !typeclasses_debug > 0 then
+           Feedback.msg_debug
+             (pr_depth info.auto_depth ++ str": no match for " ++
+                Printer.pr_constr_env (Goal.V82.env s gl) s concl ++
+                spc () ++ str ", " ++ int (List.length poss) ++
+                str" possibilities");
+         match foundone with
+         | Some e -> fk e
+         | None -> fk NotApplicable
+    in aux 1 None poss
+
+  let hints_tac hints =
+  { skft = fun sk fk gls -> hints_tac hints sk fk gls }
+
+  let then_list (second : atac) (sk : (auto_result, 'a) sk) : (auto_result, 'a) sk =
+    let rec aux s (acc : autogoal list list) fk = function
+      | (gl,info) :: gls ->
+         Control.check_for_interrupt ();
+         (match info.is_evar with
+          | Some ev when Evd.is_defined s ev -> aux s acc fk gls
+          | _ ->
+             second.skft
+               (fun {it=gls';sigma=s'} fk' ->
+                 let fk'' =
+                   if not info.unique && List.is_empty gls' &&
+                        not (needs_backtrack (Goal.V82.env s gl) s
+                                           info.is_evar (Goal.V82.concl s gl))
+                   then fk
+                   else fk'
+                 in
+                 aux s' (gls'::acc) fk'' gls)
+               fk {it = (gl,info); sigma = s; })
+      | [] -> Somek2 (List.rev acc, s, fk)
+    in fun {it = gls; sigma = s; } fk ->
+       let rec aux' = function
+         | Nonek2 e -> fk e
+         | Somek2 (res, s', fk') ->
+            let goals' = List.concat res in
+            sk {it = goals'; sigma = s'; } (fun e -> aux' (fk' e))
+       in aux' (aux s [] (fun e -> Nonek2 e) gls)
+
+  let then_tac (first : atac) (second : atac) : atac =
+    { skft = fun sk fk -> first.skft (then_list second sk) fk }
+
+  let run_tac (t : 'a tac) (gl : autogoal sigma) : auto_result option =
+    t.skft (fun x _ -> Some x) (fun _ -> None) gl
+
+  type run_list_res = auto_result optionk
+
+  let run_list_tac (t : 'a tac) p goals (gl : autogoal list sigma) : run_list_res =
+    (then_list t (fun x fk -> Somek (x, fk)))
+      gl
+      (fun _ -> Nonek)
+
+  let fail_tac reason : atac =
+    { skft = fun sk fk _ -> fk reason }
+
+  let rec fix (t : 'a tac) : 'a tac =
+    then_tac t { skft = fun sk fk -> (fix t).skft sk fk }
+
+  let rec fix_limit limit (t : 'a tac) : 'a tac =
+    if Int.equal limit 0 then fail_tac ReachedLimit
+    else then_tac t { skft = fun sk fk -> (fix_limit (pred limit) t).skft sk fk }
+
+  let fix_iterative t =
+    let rec aux depth =
+      or_else_tac (fix_limit depth t)
+                  (function
+                   | NotApplicable as e -> fail_tac e
+                   | ReachedLimit -> aux (succ depth))
+    in aux 1
+
+  let fix_iterative_limit limit (t : 'a tac) : 'a tac =
+    let rec aux depth =
+      if Int.equal limit depth then fail_tac ReachedLimit
+      else or_tac (fix_limit depth t)
+                  { skft = fun sk fk -> (aux (succ depth)).skft sk fk }
+    in aux 1
+
+  let make_autogoal ?(only_classes=true) ?(unique=false) ?(st=full_transparent_state)
+                    cut ev g =
+    let hints = make_autogoal_hints only_classes ~st g in
+    (g.it, { hints = hints ; is_evar = ev; unique = unique;
+             only_classes = only_classes; auto_depth = [];
+             auto_last_tac = lazy (str"none");
+             auto_path = []; auto_cut = cut })
+
+
+  let make_autogoals ?(only_classes=true) ?(unique=false)
+                     ?(st=full_transparent_state) hints gs evm' =
+    let cut = cut_of_hints hints in
+    let gl i g =
+      let (gl, auto) = make_autogoal ~only_classes ~unique
+                                     ~st cut (Some g) {it = g; sigma = evm'; } in
+      (gl, { auto with auto_depth = [i]})
+    in { it = List.map_i gl 1 gs; sigma = evm' }
+
+  let get_result r =
+    match r with
+    | Nonek -> None
+    | Somek (gls, fk) -> Some (gls.sigma,fk)
+
+  let run_on_evars ?(only_classes=true) ?(unique=false) ?(st=full_transparent_state)
+                   p evm hints tac =
+    match evars_to_goals p evm with
+    | None -> None (* This happens only because there's no evar having p *)
+    | Some (goals, evm') ->
+       let goals =
+         if !typeclasses_dependency_order then
+           top_sort evm' goals
+         else List.map (fun (ev, _) -> ev) (Evar.Map.bindings goals)
+       in
+       let res = run_list_tac tac p goals
+           (make_autogoals ~only_classes ~unique ~st hints goals evm') in
+       match get_result res with
+       | None -> raise Not_found
+       | Some (evm', fk) ->
+          Some (evars_reset_evd ~with_conv_pbs:true ~with_univs:false evm' evm, fk)
+
+  let eauto_tac hints =
+    then_tac normevars_tac (or_tac (hints_tac hints) intro_tac)
+
+  let eauto_tac strategy depth hints =
+    match strategy with
+    | Bfs -> 
+       begin match depth with
+       | None -> fix_iterative (eauto_tac hints)
+       | Some depth -> fix_iterative_limit depth (eauto_tac hints) end
+    | Dfs ->
+       match depth with
+       | None -> fix (eauto_tac hints)
+       | Some depth -> fix_limit depth (eauto_tac hints)
+                                
+  let real_eauto ?depth strategy unique st hints p evd =
+    let res =
+      run_on_evars ~st ~unique p evd hints (eauto_tac strategy depth hints)
+    in
     match res with
     | None -> evd
-    | Some (evd', fk) -> 
-      if unique then
-	(match get_result (fk NotApplicable) with
-	| Some (evd'', fk') -> error "Typeclass resolution gives multiple solutions"
-	| None -> evd')
-      else evd'
-    
-let resolve_all_evars_once debug limit unique p evd =
-  let db = searchtable_map typeclasses_db in
-    real_eauto ?limit unique (Hint_db.transparent_state db) [db] p evd
-
-let eauto ?(only_classes=true) ?st ?limit hints g =
-  let gl = { it = make_autogoal ~only_classes ?st (cut_of_hints hints) None g; sigma = project g; } in
-    match run_tac (eauto_tac ?limit hints) gl with
+    | Some (evd', fk) ->
+       if unique then
+         (match get_result (fk NotApplicable) with
+          | Some (evd'', fk') -> error "Typeclass resolution gives multiple solutions"
+          | None -> evd')
+       else evd'
+
+  let resolve_all_evars_once debug depth unique p evd =
+    let db = searchtable_map typeclasses_db in
+    let strategy = if get_typeclasses_iterative_deepening () then Bfs else Dfs in
+    real_eauto ?depth strategy unique (Hint_db.transparent_state db) [db] p evd
+
+  let eauto85 ?(only_classes=true) ?st ?strategy depth hints g =
+    let strategy =
+      match strategy with
+      | None -> if get_typeclasses_iterative_deepening () then Bfs else Dfs
+      | Some s -> s
+    in
+    let gl = { it = make_autogoal ~only_classes ?st
+                                  (cut_of_hints hints) None g; sigma = project g; } in
+    match run_tac (eauto_tac strategy depth hints) gl with
     | None -> raise Not_found
     | Some {it = goals; sigma = s; } ->
-	{it = List.map fst goals; sigma = s;}
+       {it = List.map fst goals; sigma = s;}
+
+end
+
+(** 8.6 resolution *)
+module Search = struct
+  type autoinfo =
+    { search_depth : int list;
+      last_tac : Pp.std_ppcmds Lazy.t;
+      search_dep : bool;
+      search_only_classes : bool;
+      search_cut : hints_path;
+      search_hints : hint_db; }
+
+  (** Local hints *)
+  let autogoal_cache = ref (DirPath.empty, true, Context.Named.empty,
+                            Hint_db.empty full_transparent_state true)
+
+  let make_autogoal_hints only_classes ?(st=full_transparent_state) g =
+    let open Proofview in
+    let open Tacmach.New in
+    let sign = Goal.hyps g in
+    let (dir, onlyc, sign', cached_hints) = !autogoal_cache in
+    let cwd = Lib.cwd () in
+    if DirPath.equal cwd dir &&
+         (onlyc == only_classes) &&
+           Context.Named.equal sign sign' &&
+             Hint_db.transparent_state cached_hints == st
+    then cached_hints
+    else
+      let hints = make_hints {it = Goal.goal g; sigma = project g}
+                             st only_classes sign
+      in
+      autogoal_cache := (cwd, only_classes, sign, hints); hints
+
+  let make_autogoal ?(st=full_transparent_state) only_classes dep cut i g =
+    let hints = make_autogoal_hints only_classes ~st g in
+    { search_hints = hints;
+      search_depth = [i]; last_tac = lazy (str"none");
+      search_dep = dep;
+      search_only_classes = only_classes;
+      search_cut = cut }
+
+  (** In the proof engine failures are represented as exceptions *)
+  exception ReachedLimitEx
+  exception NotApplicableEx
+
+  (** ReachedLimitEx has priority over NotApplicableEx to handle
+      iterative deepening: it should fail when no hints are applicable,
+      but go to a deeper depth otherwise. *)
+  let merge_exceptions e e' =
+    match fst e, fst e' with
+    | ReachedLimitEx, _ -> e
+    | _, ReachedLimitEx -> e'
+    | _, _ -> e
+
+  (** Determine if backtracking is needed for this goal.
+      If the type class is unique or in Prop
+      and there are no evars in the goal then we do
+      NOT backtrack. *)
+  let needs_backtrack env evd unique concl =
+    if unique || is_Prop env evd concl then
+      occur_existential concl
+    else true
+
+  let mark_unresolvables sigma goals =
+    List.fold_left
+      (fun sigma gl ->
+        let evi = Evd.find_undefined sigma gl in
+	let evi' = Typeclasses.mark_unresolvable evi in
+	Evd.add sigma gl evi')
+      sigma goals
+
+  let fail_if_nonclass info =
+    Proofview.Goal.enter { enter = fun gl ->
+      let gl = Proofview.Goal.assume gl in
+      let sigma = Sigma.to_evar_map (Proofview.Goal.sigma gl) in
+      if is_class_type sigma (Proofview.Goal.concl gl) then
+        Proofview.tclUNIT ()
+      else (if !typeclasses_debug > 1 then
+              Feedback.msg_debug (pr_depth info.search_depth ++
+                                    str": failure due to non-class subgoal " ++
+                                    pr_ev sigma (Proofview.Goal.goal gl));
+            Proofview.tclZERO NotApplicableEx) }
+
+  (** The general hint application tactic.
+      tac1 + tac2 .... The choice of OR or ORELSE is determined
+      depending on the dependencies of the goal and the unique/Prop
+      status *)
+  let hints_tac_gl hints info kont gl : unit Proofview.tactic =
+    let open Proofview in
+    let open Proofview.Notations in
+    let env = Goal.env gl in
+    let concl = Goal.concl gl in
+    let sigma = Goal.sigma gl in
+    let s = Sigma.to_evar_map sigma in
+    let unique = not info.search_dep || is_unique env concl in
+    let backtrack = needs_backtrack env s unique concl in
+    if !typeclasses_debug > 0 then
+      Feedback.msg_debug
+        (pr_depth info.search_depth ++ str": looking for " ++
+           Printer.pr_constr_env (Goal.env gl) s concl ++
+           (if backtrack then str" with backtracking"
+            else str" without backtracking"));
+    let secvars = compute_secvars gl in
+    let poss =
+      e_possible_resolve hints info.search_hints secvars info.search_only_classes s concl in
+    (* If no goal depends on the solution of this one or the
+       instances are irrelevant/assumed to be unique, then
+       we don't need to backtrack, as long as no evar appears in the goal
+       This is an overapproximation. Evars could appear in this goal only
+       and not any other *)
+    let ortac = if backtrack then Proofview.tclOR else Proofview.tclORELSE in
+    let idx = ref 1 in
+    let foundone = ref false in
+    let rec onetac e (tac, pat, b, name, pp) tl =
+      let derivs = path_derivate info.search_cut name in
+      let pr_error ie =
+        if !typeclasses_debug > 1 then
+          let msg =
+            pr_depth (!idx :: info.search_depth) ++ str": " ++
+              Lazy.force pp ++
+              (if !foundone != true then
+                 str" on" ++ spc () ++ pr_ev s (Proofview.Goal.goal gl)
+               else mt ())
+          in
+          Feedback.msg_debug (msg ++ str " failed with " ++ CErrors.iprint ie)
+        else ()
+      in
+      let tac_of gls i j = Goal.nf_enter { enter = fun gl' ->
+        let sigma' = Goal.sigma gl' in
+        let s' = Sigma.to_evar_map sigma' in
+        let _concl = Goal.concl gl' in
+        if !typeclasses_debug > 0 then
+          Feedback.msg_debug
+            (pr_depth (succ j :: i :: info.search_depth) ++ str" : " ++
+               pr_ev s' (Proofview.Goal.goal gl'));
+        let hints' =
+          if b && not (Context.Named.equal (Goal.hyps gl') (Goal.hyps gl))
+          then
+            let st = Hint_db.transparent_state info.search_hints in
+            make_autogoal_hints info.search_only_classes ~st gl'
+          else info.search_hints
+        in
+        let dep' = info.search_dep || Proofview.unifiable s' (Goal.goal gl') gls in
+        let info' =
+          { search_depth = succ j :: i :: info.search_depth;
+            last_tac = pp;
+            search_dep = dep';
+            search_only_classes = info.search_only_classes;
+            search_hints = hints';
+            search_cut = derivs }
+        in kont info' }
+      in
+      let rec result (shelf, ()) i k =
+        foundone := true;
+        Proofview.Unsafe.tclGETGOALS >>= fun gls ->
+        let j = List.length gls in
+        (if !typeclasses_debug > 0 then
+           Feedback.msg_debug
+             (pr_depth (i :: info.search_depth) ++ str": " ++ Lazy.force pp
+              ++ str" on" ++ spc () ++ pr_ev s (Proofview.Goal.goal gl)
+              ++ str", " ++ int j ++ str" subgoal(s)" ++
+                (Option.cata (fun k -> str " in addition to the first " ++ int k)
+                             (mt()) k)));
+        let res =
+          if j = 0 then tclUNIT ()
+          else tclDISPATCH
+                 (List.init j (fun j' -> (tac_of gls i (Option.default 0 k + j))))
+        in
+        let finish nestedshelf sigma =
+          let filter ev =
+            try
+              let evi = Evd.find_undefined sigma ev in
+              if info.search_only_classes then
+                Some (ev, not (is_class_type sigma (Evd.evar_concl evi)))
+              else Some (ev, true)
+            with Not_found -> None
+          in
+          let remaining = CList.map_filter filter shelf in
+          (if !typeclasses_debug > 1 then
+             let prunsolved (ev, _) =
+               int (Evar.repr ev) ++ spc () ++ pr_ev sigma ev in
+             let unsolved = prlist_with_sep spc prunsolved remaining in
+             Feedback.msg_debug
+               (pr_depth (i :: info.search_depth) ++
+                  str": after " ++ Lazy.force pp ++ str" finished, " ++
+                  int (List.length remaining) ++
+                  str " goals are shelved and unsolved ( " ++
+                  unsolved ++ str")"));
+          begin
+            (* Some existentials produced by the original tactic were not solved
+               in the subgoals, turn them into subgoals now. *)
+            let shelved, goals = List.partition (fun (ev, s) -> s) remaining in
+            let shelved = List.map fst shelved @ nestedshelf and goals = List.map fst goals in
+            if !typeclasses_debug > 1 && not (List.is_empty shelved && List.is_empty goals) then
+              Feedback.msg_debug
+                (str"Adding shelved subgoals to the search: " ++
+                 prlist_with_sep spc (pr_ev sigma) goals ++
+		 str" while shelving " ++
+		 prlist_with_sep spc (pr_ev sigma) shelved);
+            shelve_goals shelved <*>
+              (if List.is_empty goals then tclUNIT ()
+               else
+	         let sigma' = mark_unresolvables sigma goals in
+	         with_shelf (Unsafe.tclEVARS sigma' <*> Unsafe.tclNEWGOALS goals) >>=
+                      fun s -> result s i (Some (Option.default 0 k + j)))
+          end
+        in with_shelf res >>= fun (sh, ()) ->
+           tclEVARMAP >>= finish sh
+      in
+      if path_matches derivs [] then aux e tl
+      else
+        let filter =
+          if false (* in 8.6, still allow non-class subgoals
+                    info.search_only_classes *) then fail_if_nonclass info
+          else Proofview.tclUNIT ()
+        in
+        ortac
+             (with_shelf (tac <*> filter) >>= fun s ->
+              let i = !idx in incr idx; result s i None)
+             (fun e' ->
+	      if CErrors.noncritical (fst e') then
+                (pr_error e'; aux (merge_exceptions e e') tl)
+              else iraise e')
+    and aux e = function
+      | x :: xs -> onetac e x xs
+      | [] ->
+         if !foundone == false && !typeclasses_debug > 0 then
+           Feedback.msg_debug
+             (pr_depth info.search_depth ++ str": no match for " ++
+                Printer.pr_constr_env (Goal.env gl) s concl ++
+                spc () ++ str ", " ++ int (List.length poss) ++
+                str" possibilities");
+         match e with
+         | (ReachedLimitEx,ie) -> Proofview.tclZERO ~info:ie ReachedLimitEx
+         | (_,ie) -> Proofview.tclZERO ~info:ie NotApplicableEx
+    in
+    if backtrack then aux (NotApplicableEx,Exninfo.null) poss
+    else tclONCE (aux (NotApplicableEx,Exninfo.null) poss)
+
+  let hints_tac hints info kont : unit Proofview.tactic =
+    Proofview.Goal.nf_enter
+      { enter = fun gl -> hints_tac_gl hints info kont gl }
+
+  let intro_tac info kont gl =
+    let open Proofview in
+    let open Proofview.Notations in
+    let env = Goal.env gl in
+    let sigma = Goal.sigma gl in
+    let s = Sigma.to_evar_map sigma in
+    let decl = Tacmach.New.pf_last_hyp gl in
+    let hint =
+      make_resolve_hyp env s (Hint_db.transparent_state info.search_hints)
+                       (true,false,false) info.search_only_classes empty_hint_info decl in
+    let ldb = Hint_db.add_list env s hint info.search_hints in
+    let info' =
+      { info with search_hints = ldb; last_tac = lazy (str"intro");
+        search_depth = 1 :: 1 :: info.search_depth }
+    in kont info'
+
+  let intro info kont =
+    Proofview.tclBIND Tactics.intro
+     (fun _ -> Proofview.Goal.nf_enter { enter = fun gl -> intro_tac info kont gl })
+
+  let rec search_tac hints limit depth =
+    let kont info =
+      Proofview.numgoals >>= fun i ->
+      if !typeclasses_debug > 1 then
+        Feedback.msg_debug
+          (str"calling eauto recursively at depth " ++ int (succ depth)
+           ++ str" on " ++ int i ++ str" subgoals");
+      search_tac hints limit (succ depth) info
+    in
+    fun info ->
+    if Int.equal depth (succ limit) then Proofview.tclZERO ReachedLimitEx
+    else
+      Proofview.tclOR (hints_tac hints info kont)
+                      (fun e -> Proofview.tclOR (intro info kont)
+                      (fun e' -> let (e, info) = merge_exceptions e e' in
+                              Proofview.tclZERO ~info e))
+
+  let search_tac_gl ?st only_classes dep hints depth i sigma gls gl :
+        unit Proofview.tactic =
+    let open Proofview in
+    let open Proofview.Notations in
+    if false (* In 8.6, still allow non-class goals only_classes && not (is_class_type sigma (Goal.concl gl)) *) then
+      Tacticals.New.tclZEROMSG (str"Not a subgoal for a class")
+    else
+      let dep = dep || Proofview.unifiable sigma (Goal.goal gl) gls in
+      let info = make_autogoal ?st only_classes dep (cut_of_hints hints) i gl in
+      search_tac hints depth 1 info
+
+  let search_tac ?(st=full_transparent_state) only_classes dep hints depth =
+    let open Proofview in
+    let tac sigma gls i =
+      Goal.nf_enter
+        { enter = fun gl ->
+          search_tac_gl ~st only_classes dep hints depth (succ i) sigma gls gl }
+    in
+      Proofview.Unsafe.tclGETGOALS >>= fun gls ->
+      Proofview.tclEVARMAP >>= fun sigma ->
+      let j = List.length gls in
+      (tclDISPATCH (List.init j (fun i -> tac sigma gls i)))
+
+  let fix_iterative t =
+    let rec aux depth =
+      Proofview.tclOR
+        (t depth)
+        (function
+         | (ReachedLimitEx,_) -> aux (succ depth)
+         | (e,ie) -> Proofview.tclZERO ~info:ie e)
+    in aux 1
+
+  let fix_iterative_limit limit t =
+    let open Proofview in
+    let rec aux depth =
+      if Int.equal depth (succ limit) then tclZERO ReachedLimitEx
+      else tclOR (t depth) (function (ReachedLimitEx, _) -> aux (succ depth)
+                                   | (e,ie) -> Proofview.tclZERO ~info:ie e)
+    in aux 1
+
+  let eauto_tac ?(st=full_transparent_state) ?(unique=false)
+                ~only_classes ?strategy ~depth ~dep hints =
+    let open Proofview in
+    let tac =
+      let search = search_tac ~st only_classes dep hints in
+      let dfs =
+        match strategy with
+        | None -> not (get_typeclasses_iterative_deepening ())
+        | Some Dfs -> true
+        | Some Bfs -> false
+      in
+      if dfs then
+        let depth = match depth with None -> -1 | Some d -> d in
+        search depth
+      else
+        match depth with
+        | None -> fix_iterative search
+        | Some l -> fix_iterative_limit l search
+    in
+    let error (e, ie) =
+      match e with
+      | ReachedLimitEx ->
+         Tacticals.New.tclFAIL 0 (str"Proof search reached its limit")
+      | NotApplicableEx ->
+         Tacticals.New.tclFAIL 0 (str"Proof search failed" ++
+                                    (if Option.is_empty depth then mt()
+                                     else str" without reaching its limit"))
+      | Proofview.MoreThanOneSuccess ->
+         Tacticals.New.tclFAIL 0 (str"Proof search failed: " ++
+                                  str"more than one success found")
+      | e -> Proofview.tclZERO ~info:ie e
+    in
+    let tac = Proofview.tclOR tac error in
+    let tac =
+      if unique then
+        Proofview.tclEXACTLY_ONCE Proofview.MoreThanOneSuccess tac
+      else tac
+    in
+    with_shelf numgoals >>= fun (initshelf, i) ->
+    (if !typeclasses_debug > 1 then
+       Feedback.msg_debug (str"Starting resolution with " ++ int i ++
+                             str" goal(s) under focus and " ++
+                             int (List.length initshelf) ++ str " shelved goal(s)" ++
+                             (if only_classes then str " in only_classes mode" else str " in regular mode") ++
+                             match depth with None -> str ", unbounded"
+                                            | Some i -> str ", with depth limit " ++ int i));
+    tac
+
+  let run_on_evars p evm tac =
+    match evars_to_goals p evm with
+    | None -> None (* This happens only because there's no evar having p *)
+    | Some (goals, evm') ->
+       let goals =
+         if !typeclasses_dependency_order then
+           top_sort evm' goals
+         else List.map (fun (ev, _) -> ev) (Evar.Map.bindings goals)
+       in
+       let fgoals = Evd.future_goals evm in
+       let pgoal = Evd.principal_future_goal evm in
+       let _, pv = Proofview.init evm' [] in
+       let pv = Proofview.unshelve goals pv in
+       try
+         let (), pv', (unsafe, shelved, gaveup), _ =
+           Proofview.apply (Global.env ()) tac pv
+         in
+         if Proofview.finished pv' then
+           let evm' = Proofview.return pv' in
+           assert(Evd.fold_undefined (fun ev _ acc ->
+                      let okev = Evd.mem evm ev || List.mem ev shelved in
+                      if not okev then
+                        Feedback.msg_debug
+                          (str "leaking evar " ++ int (Evar.repr ev) ++
+                             spc () ++ pr_ev evm' ev);
+                      acc && okev) evm' true);
+           let evm' = Evd.restore_future_goals evm' (shelved @ fgoals) pgoal in
+           let evm' = evars_reset_evd ~with_conv_pbs:true ~with_univs:false evm' evm in
+           Some evm'
+         else raise Not_found
+       with Logic_monad.TacticFailure _ -> raise Not_found
+
+  let evars_eauto depth only_classes unique dep st hints p evd =
+    let eauto_tac = eauto_tac ~st ~unique ~only_classes ~depth ~dep:(unique || dep) hints in
+    let res = run_on_evars p evd eauto_tac in
+    match res with
+    | None -> evd
+    | Some evd' -> evd'
+
+  let typeclasses_eauto ?depth unique st hints p evd =
+    evars_eauto depth true unique false st hints p evd
+  (** Typeclasses eauto is an eauto which tries to resolve only
+      goals of typeclass type, and assumes that the initially selected
+      evars in evd are independent of the rest of the evars *)
+
+  let typeclasses_resolve debug depth unique p evd =
+    let db = searchtable_map typeclasses_db in
+    typeclasses_eauto ?depth unique (Hint_db.transparent_state db) [db] p evd
+end
+
+(** Binding to either V85 or Search implementations. *)
+
+let typeclasses_eauto ?(only_classes=false) ?(st=full_transparent_state)
+                      ?strategy ~depth dbs =
+  let dbs = List.map_filter
+              (fun db -> try Some (searchtable_map db)
+                      with e when CErrors.noncritical e -> None)
+              dbs
+  in
+  let st = match dbs with x :: _ -> Hint_db.transparent_state x | _ -> st in
+  let depth = match depth with None -> get_typeclasses_depth () | Some l -> Some l in
+  if get_typeclasses_legacy_resolution () then
+    Proofview.V82.tactic
+    (fun gl ->
+      try V85.eauto85 depth ~only_classes ~st ?strategy dbs gl
+      with Not_found ->
+	Refiner.tclFAIL 0 (str"Proof search failed") gl)
+  else Search.eauto_tac ~st ~only_classes ?strategy ~depth ~dep:true dbs
 
 (** We compute dependencies via a union-find algorithm.
     Beware of the imperative effects on the partition structure,
@@ -682,24 +1422,6 @@ let evar_dependencies evm p =
       in Intpart.union_set evars p)
     evm ()
 
-let resolve_one_typeclass env ?(sigma=Evd.empty) gl unique =
-  let nc, gl, subst, _, _ = Evarutil.push_rel_context_to_named_context env gl in
-  let (gl,t,sigma) =
-    Goal.V82.mk_goal sigma nc gl Store.empty in
-  let gls = { it = gl ; sigma = sigma; } in
-  let hints = searchtable_map typeclasses_db in
-  let gls' = eauto ?limit:!typeclasses_depth ~st:(Hint_db.transparent_state hints) [hints] gls in
-  let evd = sig_sig gls' in
-  let t' = let (ev, inst) = destEvar t in
-    mkEvar (ev, Array.of_list subst)
-  in
-  let term = Evarutil.nf_evar evd t' in
-    evd, term
-
-let _ =
-  Typeclasses.solve_instantiation_problem := 
-    (fun x y z w -> resolve_one_typeclass x ~sigma:y z w)
-
 (** [split_evars] returns groups of undefined evars according to dependencies *)
 
 let split_evars evm =
@@ -715,9 +1437,9 @@ let is_inference_forced p evd ev =
     then
       let (loc, k) = evar_source ev evd in
       match k with
-	| Evar_kinds.ImplicitArg (_, _, b) -> b
-	| Evar_kinds.QuestionMark _ -> false
-	| _ -> true
+        | Evar_kinds.ImplicitArg (_, _, b) -> b
+        | Evar_kinds.QuestionMark _ -> false
+        | _ -> true
     else true
   with Not_found -> assert false
 
@@ -784,12 +1506,11 @@ let revert_resolvability oevd evd =
   in
   Evd.raw_map_undefined map evd
 
-(** If [do_split] is [true], we try to separate the problem in
-    several components and then solve them separately *)
-
 exception Unresolved
 
-let resolve_all_evars debug m unique env p oevd do_split fail =
+(** If [do_split] is [true], we try to separate the problem in
+    several components and then solve them separately *)
+let resolve_all_evars debug depth unique env p oevd do_split fail =
   let split = if do_split then split_evars oevd else [Evar.Set.empty] in
   let in_comp comp ev = if do_split then Evar.Set.mem ev comp else true
   in
@@ -798,16 +1519,21 @@ let resolve_all_evars debug m unique env p oevd do_split fail =
     | comp :: comps ->
       let p = select_and_update_evars p oevd (in_comp comp) in
       try
-	 let evd' = resolve_all_evars_once debug m unique p evd in
-	 if has_undefined p oevd evd' then raise Unresolved;
-	 docomp evd' comps
+        let evd' =
+          if get_typeclasses_legacy_resolution () then
+            V85.resolve_all_evars_once debug depth unique p evd
+          else
+            Search.typeclasses_resolve debug depth unique p evd
+        in
+         if has_undefined p oevd evd' then raise Unresolved;
+         docomp evd' comps
       with Unresolved | Not_found ->
-	if fail && (not do_split || is_mandatory (p evd) comp evd)
-	then (* Unable to satisfy the constraints. *)
+        if fail && (not do_split || is_mandatory (p evd) comp evd)
+        then (* Unable to satisfy the constraints. *)
           let comp = if do_split then Some comp else None in
-	  error_unresolvable env comp evd
-	else (* Best effort: do nothing on this component *)
-	  docomp evd comps
+          error_unresolvable env comp evd
+        else (* Best effort: do nothing on this component *)
+          docomp evd comps
   in docomp oevd split
 
 let initial_select_evars filter =
@@ -815,70 +1541,51 @@ let initial_select_evars filter =
     filter ev (snd evi.Evd.evar_source) &&
     Typeclasses.is_class_evar evd evi
 
-let resolve_typeclass_evars debug m unique env evd filter split fail =
+let resolve_typeclass_evars debug depth unique env evd filter split fail =
   let evd =
-    try Evarconv.consider_remaining_unif_problems
+    try Evarconv.solve_unif_constraints_with_heuristics
       ~ts:(Typeclasses.classes_transparent_state ()) env evd
-    with e when Errors.noncritical e -> evd
+    with e when CErrors.noncritical e -> evd
   in
-    resolve_all_evars debug m unique env (initial_select_evars filter) evd split fail
+    resolve_all_evars debug depth unique env
+                      (initial_select_evars filter) evd split fail
 
-let solve_inst debug depth env evd filter unique split fail =
-  resolve_typeclass_evars debug depth unique env evd filter split fail
+let solve_inst env evd filter unique split fail =
+  resolve_typeclass_evars
+    (get_typeclasses_debug ())
+    (get_typeclasses_depth ())
+    unique env evd filter split fail
 
 let _ =
-  Typeclasses.solve_instantiations_problem :=
-    solve_inst false !typeclasses_depth
-
-let set_typeclasses_debug d = (:=) typeclasses_debug d;
-  Typeclasses.solve_instantiations_problem := solve_inst d !typeclasses_depth
-
-let get_typeclasses_debug () = !typeclasses_debug
+  Hook.set Typeclasses.solve_all_instances_hook solve_inst
 
-let set_typeclasses_depth d = (:=) typeclasses_depth d;
-  Typeclasses.solve_instantiations_problem := solve_inst !typeclasses_debug !typeclasses_depth
-
-let get_typeclasses_depth () = !typeclasses_depth
-
-open Goptions
-
-let set_typeclasses_debug =
-  declare_bool_option
-    { optsync  = true;
-      optdepr  = false;
-      optname  = "debug output for typeclasses proof search";
-      optkey   = ["Typeclasses";"Debug"];
-      optread  = get_typeclasses_debug;
-      optwrite = set_typeclasses_debug; }
-
-let set_typeclasses_debug =
-  declare_bool_option
-    { optsync  = true;
-      optdepr  = false;
-      optname  = "debug output for typeclasses proof search";
-      optkey   = ["Debug";"Typeclasses"];
-      optread  = get_typeclasses_debug;
-      optwrite = set_typeclasses_debug; }
-
-let set_typeclasses_depth =
-  declare_int_option
-    { optsync  = true;
-      optdepr  = false;
-      optname  = "depth for typeclasses proof search";
-      optkey   = ["Typeclasses";"Depth"];
-      optread  = get_typeclasses_depth;
-      optwrite = set_typeclasses_depth; }
+let resolve_one_typeclass env ?(sigma=Evd.empty) gl unique =
+  let nc, gl, subst, _, _ = Evarutil.push_rel_context_to_named_context env gl in
+  let (gl,t,sigma) =
+    Goal.V82.mk_goal sigma nc gl Store.empty in
+  let gls = { it = gl ; sigma = sigma; } in
+  let hints = searchtable_map typeclasses_db in
+  let st = Hint_db.transparent_state hints in
+  let depth = get_typeclasses_depth () in
+  let gls' =
+    if get_typeclasses_legacy_resolution () then
+      V85.eauto85 depth ~st [hints] gls
+    else
+      try
+        Proofview.V82.of_tactic
+        (Search.eauto_tac ~st ~only_classes:true ~depth [hints] ~dep:true) gls
+      with Refiner.FailError _ -> raise Not_found
+  in
+  let evd = sig_sig gls' in
+  let t' = let (ev, inst) = destEvar t in
+    mkEvar (ev, Array.of_list subst)
+  in
+  let term = Evarutil.nf_evar evd t' in
+    evd, term
 
-let typeclasses_eauto ?(only_classes=false) ?(st=full_transparent_state) dbs gl =
-  try
-    let dbs = List.map_filter
-      (fun db -> try Some (searchtable_map db)
-        with e when Errors.noncritical e -> None)
-      dbs
-    in
-    let st = match dbs with x :: _ -> Hint_db.transparent_state x | _ -> st in
-      eauto ?limit:!typeclasses_depth ~only_classes ~st dbs gl
-   with Not_found -> tclFAIL 0 (str" typeclasses eauto failed on: " ++ Printer.pr_goal gl) gl
+let _ =
+  Hook.set Typeclasses.solve_one_instance_hook
+    (fun x y z w -> resolve_one_typeclass x ~sigma:y z w)
 
 (** Take the head of the arity of a constr.
     Used in the partial application tactic. *)
@@ -895,18 +1602,21 @@ let head_of_constr h c =
   let c = head_of_constr c in
   letin_tac None (Name h) c None Locusops.allHyps
 
-let not_evar c = match kind_of_term c with
-| Evar _ -> Tacticals.New.tclFAIL 0 (str"Evar")
-| _ -> Proofview.tclUNIT ()
+let not_evar c =
+  Proofview.tclEVARMAP >>= fun sigma ->
+  match Evarutil.kind_of_term_upto sigma c with
+  | Evar _ -> Tacticals.New.tclFAIL 0 (str"Evar")
+  | _ -> Proofview.tclUNIT ()
 
 let is_ground c gl =
   if Evarutil.is_ground_term (project gl) c then tclIDTAC gl
   else tclFAIL 0 (str"Not ground") gl
 
 let autoapply c i gl =
-  let flags = auto_unif_flags Evar.Set.empty 
+  let flags = auto_unif_flags Evar.Set.empty
     (Hints.Hint_db.transparent_state (Hints.searchtable_map i)) in
   let cty = pf_unsafe_type_of gl c in
   let ce = mk_clenv_from gl (c,cty) in
-  let tac = { enter = fun gl -> (unify_e_resolve false flags).enter gl ((c,cty,Univ.ContextSet.empty),ce) } in
+  let tac = { enter = fun gl -> (unify_e_resolve false flags).enter gl
+    ((c,cty,Univ.ContextSet.empty),0,ce) } in
   Proofview.V82.of_tactic (Proofview.Goal.nf_enter tac) gl
diff --git a/tactics/class_tactics.mli b/tactics/class_tactics.mli
index f1bcfa7dd..76760db02 100644
--- a/tactics/class_tactics.mli
+++ b/tactics/class_tactics.mli
@@ -6,6 +6,8 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
+(** This files implements typeclasses eauto *)
+
 open Names
 open Constr
 open Tacmach
@@ -18,10 +20,13 @@ val get_typeclasses_debug : unit -> bool
 val set_typeclasses_depth : int option -> unit
 val get_typeclasses_depth : unit -> int option
 
-val progress_evars : unit Proofview.tactic -> unit Proofview.tactic
+type search_strategy = Dfs | Bfs
+
+val set_typeclasses_strategy : search_strategy -> unit
 
-val typeclasses_eauto : ?only_classes:bool -> ?st:transparent_state ->
-  Hints.hint_db_name list -> tactic
+val typeclasses_eauto : ?only_classes:bool -> ?st:transparent_state -> ?strategy:search_strategy ->
+                        depth:(Int.t option) ->
+                        Hints.hint_db_name list -> unit Proofview.tactic
 
 val head_of_constr : Id.t -> Term.constr -> unit Proofview.tactic
 
@@ -30,3 +35,23 @@ val not_evar : constr -> unit Proofview.tactic
 val is_ground : constr -> tactic
 
 val autoapply : constr -> Hints.hint_db_name -> tactic
+
+module Search : sig
+  val eauto_tac :
+    ?st:Names.transparent_state ->
+    (** The transparent_state used when working with local hypotheses  *)
+    ?unique:bool ->
+    (** Should we force a unique solution *)
+    only_classes:bool ->
+    (** Should non-class goals be shelved and resolved at the end *)
+    ?strategy:search_strategy ->
+    (** Is a traversing-strategy specified? *)
+    depth:Int.t option ->
+    (** Bounded or unbounded search *)
+    dep:bool ->
+    (** Should the tactic be made backtracking on the initial goals,
+       whatever their internal dependencies are. *)
+    Hints.hint_db list ->
+    (** The list of hint databases to use *)
+    unit Proofview.tactic
+end
diff --git a/tactics/contradiction.ml b/tactics/contradiction.ml
index 26166bd83..6b29f574c 100644
--- a/tactics/contradiction.ml
+++ b/tactics/contradiction.ml
@@ -13,7 +13,8 @@ open Coqlib
 open Reductionops
 open Misctypes
 open Proofview.Notations
-open Context.Named.Declaration
+
+module NamedDecl = Context.Named.Declaration
 
 (* Absurd *)
 
@@ -42,11 +43,13 @@ let absurd c = absurd c
 
 (* Contradiction *)
 
+let use_negated_unit_or_eq_type () = Flags.version_strictly_greater Flags.V8_5
+
 (** [f] does not assume its argument to be [nf_evar]-ed. *)
 let filter_hyp f tac =
   let rec seek = function
     | [] -> Proofview.tclZERO Not_found
-    | d::rest when f (get_type d) -> tac (get_id d)
+    | d::rest when f (NamedDecl.get_type d) -> tac (NamedDecl.get_id d)
     | _::rest -> seek rest in
   Proofview.Goal.enter { enter = begin fun gl ->
     let hyps = Proofview.Goal.hyps (Proofview.Goal.assume gl) in
@@ -60,13 +63,28 @@ let contradiction_context =
     let rec seek_neg l = match l with
       | [] ->  Tacticals.New.tclZEROMSG (Pp.str"No such contradiction")
       | d :: rest ->
-          let id = get_id d in
-          let typ = nf_evar sigma (get_type d) in
-	  let typ = whd_betadeltaiota env sigma typ in
+          let id = NamedDecl.get_id d in
+          let typ = nf_evar sigma (NamedDecl.get_type d) in
+	  let typ = whd_all env sigma typ in
 	  if is_empty_type typ then
 	    simplest_elim (mkVar id)
 	  else match kind_of_term typ with
 	  | Prod (na,t,u) when is_empty_type u ->
+             let is_unit_or_eq =
+               if use_negated_unit_or_eq_type () then match_with_unit_or_eq_type t
+               else None in
+	     Tacticals.New.tclORELSE
+               (match is_unit_or_eq with
+               | Some _ ->
+                   let hd,args = decompose_app t in
+                   let (ind,_ as indu) = destInd hd in
+                   let nparams = Inductiveops.inductive_nparams_env env ind in
+                   let params = Util.List.firstn nparams args in
+                   let p = applist ((mkConstructUi (indu,1)), params) in
+                   (* Checking on the fly that it type-checks *)
+                   simplest_elim (mkApp (mkVar id,[|p|]))
+               | None ->
+                 Tacticals.New.tclZEROMSG (Pp.str"Not a negated unit type."))
 	      (Proofview.tclORELSE
                  (Proofview.Goal.enter { enter = begin fun gl ->
                    let is_conv_leq = Tacmach.New.pf_apply is_conv_leq gl in
@@ -84,7 +102,7 @@ let contradiction_context =
   end }
 
 let is_negation_of env sigma typ t =
-  match kind_of_term (whd_betadeltaiota env sigma t) with
+  match kind_of_term (whd_all env sigma t) with
     | Prod (na,t,u) ->
       let u = nf_evar sigma u in
       is_empty_type u && is_conv_leq env sigma typ t
diff --git a/tactics/eauto.ml b/tactics/eauto.ml
index 2cae9b794..885183174 100644
--- a/tactics/eauto.ml
+++ b/tactics/eauto.ml
@@ -7,7 +7,7 @@
 (************************************************************************)
 
 open Pp
-open Errors
+open CErrors
 open Util
 open Names
 open Nameops
@@ -20,7 +20,7 @@ open Tactics
 open Clenv
 open Auto
 open Genredexpr
-open Tacexpr
+open Tactypes
 open Locus
 open Locusops
 open Hints
@@ -29,9 +29,9 @@ open Proofview.Notations
 let eauto_unif_flags = auto_flags_of_state full_transparent_state
 
 let e_give_exact ?(flags=eauto_unif_flags) c =
-  Proofview.Goal.nf_enter { enter = begin fun gl ->
+  Proofview.Goal.enter { enter = begin fun gl ->
   let t1 = Tacmach.New.pf_unsafe_type_of gl c in
-  let t2 = Tacmach.New.pf_concl gl in
+  let t2 = Tacmach.New.pf_concl (Proofview.Goal.assume gl) in
   if occur_existential t1 || occur_existential t2 then
      Tacticals.New.tclTHEN (Clenvtac.unify ~flags t1) (exact_no_check c)
   else exact_check c
@@ -97,8 +97,8 @@ let prolog_tac l n =
   in
   let l = List.map map l in
   try (prolog l n gl)
-  with UserError ("Refiner.tclFIRST",_) ->
-    errorlabstrm "Prolog.prolog" (str "Prolog failed.")
+  with UserError (Some "Refiner.tclFIRST",_) ->
+    user_err ~hdr:"Prolog.prolog" (str "Prolog failed.")
   end
 
 open Auto
@@ -108,7 +108,7 @@ open Auto
 (***************************************************************************)
 
 let priority l = List.map snd (List.filter (fun (pr,_) -> Int.equal pr 0) l)
-			  
+
 let unify_e_resolve poly flags (c,clenv) =
   Proofview.Goal.nf_enter { enter = begin fun gl ->
       let clenv', c = connect_hint_clenv poly c clenv gl in
@@ -119,20 +119,22 @@ let unify_e_resolve poly flags (c,clenv) =
 		 (Proofview.V82.of_tactic (Tactics.Simple.eapply c)) gls)
     end }
 
-let hintmap_of hdc concl =
+let hintmap_of secvars hdc concl =
   match hdc with
-  | None -> fun db -> Hint_db.map_none db
+  | None -> fun db -> Hint_db.map_none ~secvars db
   | Some hdc ->
-    if occur_existential concl then (fun db -> Hint_db.map_existential hdc concl db)
-    else (fun db -> Hint_db.map_auto hdc concl db)
+     if occur_existential concl then
+       (fun db -> Hint_db.map_existential ~secvars hdc concl db)
+     else (fun db -> Hint_db.map_auto ~secvars hdc concl db)
    (* FIXME: should be (Hint_db.map_eauto hdc concl db) *)
 
 let e_exact poly flags (c,clenv) =
-  let (c, _, _) = c in
-  let clenv', subst = 
-    if poly then Clenv.refresh_undefined_univs clenv 
-    else clenv, Univ.empty_level_subst
-  in e_give_exact (* ~flags *) (Vars.subst_univs_level_constr subst c)
+  Proofview.Goal.enter { enter = begin fun gl ->
+    let clenv', c = connect_hint_clenv poly c clenv gl in
+    Tacticals.New.tclTHEN
+    (Proofview.Unsafe.tclEVARUNIVCONTEXT (Evd.evar_universe_context clenv'.evd))
+    (e_give_exact c)
+  end }
 
 let rec e_trivial_fail_db db_list local_db =
   let next = Proofview.Goal.nf_enter { enter = begin fun gl ->
@@ -141,16 +143,17 @@ let rec e_trivial_fail_db db_list local_db =
     e_trivial_fail_db db_list (Hint_db.add_list (Tacmach.New.pf_env gl) (Tacmach.New.project gl) hintl local_db)
   end } in
   Proofview.Goal.enter { enter = begin fun gl ->
+  let secvars = compute_secvars gl in
   let tacl =
     registered_e_assumption ::
     (Tacticals.New.tclTHEN Tactics.intro next) ::
-    (List.map fst (e_trivial_resolve db_list local_db (Tacmach.New.pf_nf_concl gl)))
+    (List.map fst (e_trivial_resolve db_list local_db secvars (Tacmach.New.pf_nf_concl gl)))
   in
   Tacticals.New.tclFIRST (List.map Tacticals.New.tclCOMPLETE tacl)
   end }
 
-and e_my_find_search db_list local_db hdc concl =
-  let hint_of_db = hintmap_of hdc concl in
+and e_my_find_search db_list local_db secvars hdc concl =
+  let hint_of_db = hintmap_of secvars hdc concl in
   let hintl =
       List.map_append (fun db ->
 	let flags = auto_flags_of_state (Hint_db.transparent_state db) in
@@ -178,14 +181,15 @@ and e_my_find_search db_list local_db hdc concl =
   in
   List.map tac_of_hint hintl
 
-and e_trivial_resolve db_list local_db gl =
+and e_trivial_resolve db_list local_db secvars gl =
   let hd = try Some (decompose_app_bound gl) with Bound -> None in
-  try priority (e_my_find_search db_list local_db hd gl)
+  try priority (e_my_find_search db_list local_db secvars hd gl)
   with Not_found -> []
 
-let e_possible_resolve db_list local_db gl =
+let e_possible_resolve db_list local_db secvars gl =
   let hd = try Some (decompose_app_bound gl) with Bound -> None in
-  try List.map (fun (b, (tac, pp)) -> (tac, b, pp)) (e_my_find_search db_list local_db hd gl)
+  try List.map (fun (b, (tac, pp)) -> (tac, b, pp))
+               (e_my_find_search db_list local_db secvars hd gl)
   with Not_found -> []
 
 let find_first_goal gls =
@@ -202,7 +206,7 @@ type search_state = {
   dblist : hint_db list;
   localdb :  hint_db list;
   prev : prev_search_state;
-  local_lemmas : Tacexpr.delayed_open_constr list;
+  local_lemmas : delayed_open_constr list;
 }
 
 and prev_search_state = (* for info eauto *)
@@ -230,8 +234,8 @@ module SearchProblem = struct
 (* 	    let gl = Proof_trees.db_pr_goal (List.hd (sig_it glls)) in *)
 (* 	      msg (hov 1 (pptac ++ str" gives: \n" ++ pr_goals lgls ++ str"\n")); *)
 	      (lgls, cost, pptac) :: aux tacl
-	  with e when Errors.noncritical e ->
-            let e = Errors.push e in
+	  with e when CErrors.noncritical e ->
+            let e = CErrors.push e in
             Refiner.catch_failerror e; aux tacl
     in aux l
 
@@ -254,9 +258,11 @@ module SearchProblem = struct
       let nbgl = List.length (sig_it lg) in
       assert (nbgl > 0);
       let g = find_first_goal lg in
+      let hyps = pf_ids_of_hyps g in
+      let secvars = secvars_of_hyps (pf_hyps g) in
       let map_assum id = (e_give_exact (mkVar id), (-1), lazy (str "exact" ++ spc () ++ pr_id id)) in
       let assumption_tacs =
-        let tacs = List.map map_assum (pf_ids_of_hyps g) in
+        let tacs = List.map map_assum hyps in
         let l = filter_tactics s.tacres tacs in
 	List.map (fun (res, cost, pp) -> { depth = s.depth; priority = cost; tacres = res;
 				    last_tactic = pp; dblist = s.dblist;
@@ -281,7 +287,9 @@ module SearchProblem = struct
       in
       let rec_tacs =
 	let l =
-	  filter_tactics s.tacres (e_possible_resolve s.dblist (List.hd s.localdb) (pf_concl g))
+          let concl = Reductionops.nf_evar (project g)(pf_concl g) in
+	  filter_tactics s.tacres
+                         (e_possible_resolve s.dblist (List.hd s.localdb) secvars concl)
 	in
 	List.map
 	  (fun (lgls, cost, pp) ->
@@ -344,13 +352,13 @@ let mk_eauto_dbg d =
   else Off
 
 let pr_info_nop = function
-  | Info -> Feedback.msg_debug (str "idtac.")
+  | Info -> Feedback.msg_info (str "idtac.")
   | _ -> ()
 
 let pr_dbg_header = function
   | Off -> ()
-  | Debug -> Feedback.msg_debug (str "(* debug eauto : *)")
-  | Info  -> Feedback.msg_debug (str "(* info eauto : *)")
+  | Debug -> Feedback.msg_debug (str "(* debug eauto: *)")
+  | Info  -> Feedback.msg_info (str "(* info eauto: *)")
 
 let pr_info dbg s =
   if dbg != Info then ()
@@ -361,7 +369,7 @@ let pr_info dbg s =
 	| State sp ->
 	  let mindepth = loop sp in
 	  let indent = String.make (mindepth - sp.depth) ' ' in
-	  Feedback.msg_debug (str indent ++ Lazy.force s.last_tactic ++ str ".");
+	  Feedback.msg_info (str indent ++ Lazy.force s.last_tactic ++ str ".");
 	  mindepth
     in
     ignore (loop s)
@@ -408,9 +416,7 @@ let eauto ?(debug=Off) np lems dbnames =
   tclTRY (e_search_auto debug np lems db_list)
 
 let full_eauto ?(debug=Off) n lems gl =
-  let dbnames = current_db_names () in
-  let dbnames =  String.Set.remove "v62" dbnames in
-  let db_list = List.map searchtable_map (String.Set.elements dbnames) in
+  let db_list = current_pure_db () in
   tclTRY (e_search_auto debug n lems db_list) gl
 
 let gen_eauto ?(debug=Off) np lems = function
@@ -430,7 +436,7 @@ let cons a l = a :: l
 let autounfolds db occs cls gl =
   let unfolds = List.concat (List.map (fun dbname -> 
     let db = try searchtable_map dbname 
-      with Not_found -> errorlabstrm "autounfold" (str "Unknown database " ++ str dbname)
+      with Not_found -> user_err ~hdr:"autounfold" (str "Unknown database " ++ str dbname)
     in
     let (ids, csts) = Hint_db.unfolds db in
     let hyps = pf_ids_of_hyps gl in
@@ -497,7 +503,7 @@ let autounfold_one db cl =
   let st =
     List.fold_left (fun (i,c) dbname -> 
       let db = try searchtable_map dbname 
-	with Not_found -> errorlabstrm "autounfold" (str "Unknown database " ++ str dbname)
+	with Not_found -> user_err ~hdr:"autounfold" (str "Unknown database " ++ str dbname)
       in
       let (ids, csts) = Hint_db.unfolds db in
 	(Id.Set.union ids i, Cset.union csts c)) (Id.Set.empty, Cset.empty) db
diff --git a/tactics/eauto.mli b/tactics/eauto.mli
index 8812093d5..1f69e4ab3 100644
--- a/tactics/eauto.mli
+++ b/tactics/eauto.mli
@@ -9,6 +9,7 @@
 open Term
 open Proof_type
 open Hints
+open Tactypes
 
 val e_assumption : unit Proofview.tactic
 
@@ -16,15 +17,15 @@ val registered_e_assumption : unit Proofview.tactic
 
 val e_give_exact : ?flags:Unification.unify_flags -> constr -> unit Proofview.tactic
 
-val prolog_tac : Tacexpr.delayed_open_constr list -> int -> unit Proofview.tactic
+val prolog_tac : delayed_open_constr list -> int -> unit Proofview.tactic
 
-val gen_eauto : ?debug:Tacexpr.debug -> bool * int -> Tacexpr.delayed_open_constr list ->
+val gen_eauto : ?debug:debug -> bool * int -> delayed_open_constr list ->
   hint_db_name list option -> unit Proofview.tactic
 
 val eauto_with_bases :
-  ?debug:Tacexpr.debug ->
+  ?debug:debug ->
   bool * int ->
-  Tacexpr.delayed_open_constr list -> hint_db list -> Proof_type.tactic
+  delayed_open_constr list -> hint_db list -> Proof_type.tactic
 
 val autounfold : hint_db_name list -> Locus.clause -> unit Proofview.tactic
 val autounfold_tac : hint_db_name list option -> Locus.clause -> unit Proofview.tactic
diff --git a/tactics/elim.ml b/tactics/elim.ml
index d59c2fba4..3f0c01a29 100644
--- a/tactics/elim.ml
+++ b/tactics/elim.ml
@@ -16,7 +16,8 @@ open Tacmach.New
 open Tacticals.New
 open Tactics
 open Proofview.Notations
-open Context.Named.Declaration
+
+module NamedDecl = Context.Named.Declaration
 
 (* Supposed to be called without as clause *)
 let introElimAssumsThen tac ba =
@@ -25,14 +26,14 @@ let introElimAssumsThen tac ba =
   (tclTHEN introElimAssums (elim_on_ba tac ba))
 
 (* Supposed to be called with a non-recursive scheme *)
-let introCaseAssumsThen tac ba =
+let introCaseAssumsThen with_evars tac ba =
   let n1 = List.length ba.Tacticals.branchsign in
   let n2 = List.length ba.Tacticals.branchnames in
   let (l1,l2),l3 =
     if n1 < n2 then List.chop n1 ba.Tacticals.branchnames, []
     else (ba.Tacticals.branchnames, []), List.make (n1-n2) false in
   let introCaseAssums =
-    tclTHEN (intro_patterns l1) (intros_clearing l3) in
+    tclTHEN (intro_patterns with_evars l1) (intros_clearing l3) in
   (tclTHEN introCaseAssums (case_on_ba (tac l2) ba))
 
 (* The following tactic Decompose repeatedly applies the
@@ -139,7 +140,7 @@ let induction_trailer abs_i abs_j bargs =
 	  let (hyps,_) =
             List.fold_left
 	      (fun (bring_ids,leave_ids) d ->
-                 let cid = get_id d in
+                 let cid = NamedDecl.get_id d in
                  if not (List.mem cid leave_ids)
                  then (d::bring_ids,leave_ids)
                  else (bring_ids,cid::leave_ids))
diff --git a/tactics/elim.mli b/tactics/elim.mli
index a94f642a0..29c441463 100644
--- a/tactics/elim.mli
+++ b/tactics/elim.mli
@@ -10,11 +10,12 @@ open Names
 open Term
 open Tacticals
 open Misctypes
+open Tactypes
 
 (** Eliminations tactics. *)
 
-val introCaseAssumsThen :
-  (Tacexpr.intro_patterns -> branch_assumptions -> unit Proofview.tactic) ->
+val introCaseAssumsThen : evars_flag ->
+  (intro_patterns -> branch_assumptions -> unit Proofview.tactic) ->
     branch_args -> unit Proofview.tactic
 
 val h_decompose       : inductive list -> constr -> unit Proofview.tactic
diff --git a/tactics/elimschemes.ml b/tactics/elimschemes.ml
index de2818902..93073fdc7 100644
--- a/tactics/elimschemes.ml
+++ b/tactics/elimschemes.ml
@@ -52,19 +52,21 @@ let optimize_non_type_induction_scheme kind dep sort _ ind =
     let u = Univ.UContext.instance ctx in
     let ctxset = Univ.ContextSet.of_context ctx in
     let ectx = Evd.evar_universe_context_of ctxset in
-    let sigma, c = build_induction_scheme env (Evd.from_ctx ectx) (ind,u) dep sort in
+    let sigma = Evd.merge_universe_context sigma ectx in
+    let sigma, c = build_induction_scheme env sigma (ind,u) dep sort in
       (c, Evd.evar_universe_context sigma), Safe_typing.empty_private_constants
 
 let build_induction_scheme_in_type dep sort ind =
   let env = Global.env () in
+  let sigma = Evd.from_env env in
   let ctx = 
     let mib,mip = Inductive.lookup_mind_specif env ind in
       Declareops.inductive_context mib
   in
   let u = Univ.UContext.instance ctx in
   let ctxset = Univ.ContextSet.of_context ctx in
-  let ectx = Evd.evar_universe_context_of ctxset in
-  let sigma, c = build_induction_scheme env (Evd.from_ctx ectx) (ind,u) dep sort in
+  let sigma = Evd.merge_universe_context sigma (Evd.evar_universe_context_of ctxset) in
+  let sigma, c = build_induction_scheme env sigma (ind,u) dep sort in
     c, Evd.evar_universe_context sigma
  
 let rect_scheme_kind_from_type =
@@ -95,6 +97,10 @@ let rec_scheme_kind_from_prop =
   declare_individual_scheme_object "_rec" ~aux:"_rec_from_prop"
   (optimize_non_type_induction_scheme rect_scheme_kind_from_prop false InSet)
 
+let rec_scheme_kind_from_type =
+  declare_individual_scheme_object "_rec_nodep" ~aux:"_rec_nodep_from_type"
+  (optimize_non_type_induction_scheme rect_scheme_kind_from_type false InSet)
+
 let rec_dep_scheme_kind_from_type =
   declare_individual_scheme_object "_rec" ~aux:"_rec_from_type"
   (optimize_non_type_induction_scheme rect_dep_scheme_kind_from_type true InSet)
diff --git a/tactics/elimschemes.mli b/tactics/elimschemes.mli
index c36797059..77f927f2d 100644
--- a/tactics/elimschemes.mli
+++ b/tactics/elimschemes.mli
@@ -13,9 +13,11 @@ open Ind_tables
 val rect_scheme_kind_from_prop : individual scheme_kind
 val ind_scheme_kind_from_prop : individual scheme_kind
 val rec_scheme_kind_from_prop : individual scheme_kind
+val rect_scheme_kind_from_type : individual scheme_kind
 val rect_dep_scheme_kind_from_type : individual scheme_kind
 val ind_scheme_kind_from_type : individual scheme_kind
 val ind_dep_scheme_kind_from_type : individual scheme_kind
+val rec_scheme_kind_from_type : individual scheme_kind
 val rec_dep_scheme_kind_from_type : individual scheme_kind
 
 
diff --git a/tactics/eqdecide.ml b/tactics/eqdecide.ml
index b1d3290aa..1a67bedc2 100644
--- a/tactics/eqdecide.ml
+++ b/tactics/eqdecide.ml
@@ -22,6 +22,7 @@ open Tacticals.New
 open Auto
 open Constr_matching
 open Misctypes
+open Tactypes
 open Hipattern
 open Pretyping
 open Tacmach.New
@@ -73,7 +74,7 @@ let mkBranches c1 c2 =
 
 let discrHyp id =
   let c = { delayed = fun env sigma -> Sigma.here (Term.mkVar id, NoBindings) sigma } in
-  let tac c = Equality.discr_tac false (Some (None, Tacexpr.ElimOnConstr c)) in
+  let tac c = Equality.discr_tac false (Some (None, ElimOnConstr c)) in
   Tacticals.New.tclDELAYEDWITHHOLES false c tac
 
 let solveNoteqBranch side =
@@ -121,7 +122,7 @@ let eqCase tac =
 
 let injHyp id =
   let c = { delayed = fun env sigma -> Sigma.here (Term.mkVar id, NoBindings) sigma } in
-  let tac c = Equality.injClause None false (Some (None, Tacexpr.ElimOnConstr c)) in
+  let tac c = Equality.injClause None false (Some (None, ElimOnConstr c)) in
   Tacticals.New.tclDELAYEDWITHHOLES false c tac
 
 let diseqCase hyps eqonleft =
diff --git a/tactics/eqschemes.ml b/tactics/eqschemes.ml
index a03489c80..c94dcfa9d 100644
--- a/tactics/eqschemes.ml
+++ b/tactics/eqschemes.ml
@@ -44,7 +44,7 @@
    natural expectation of the user.
 *)
 
-open Errors
+open CErrors
 open Util
 open Names
 open Term
@@ -60,6 +60,8 @@ open Indrec
 open Sigma.Notations
 open Context.Rel.Declaration
 
+module RelDecl = Context.Rel.Declaration
+
 let hid = Id.of_string "H"
 let xid = Id.of_string "X"
 let default_id_of_sort = function InProp | InSet -> hid | InType -> xid
@@ -600,9 +602,9 @@ let fix_r2l_forward_rew_scheme (c, ctx') =
   | hp :: p :: ind :: indargs ->
      let c' = 
       my_it_mkLambda_or_LetIn indargs
-        (mkLambda_or_LetIn (map_constr (liftn (-1) 1) p)
-	  (mkLambda_or_LetIn (map_constr (liftn (-1) 2) hp)
-	    (mkLambda_or_LetIn (map_constr (lift 2) ind)
+        (mkLambda_or_LetIn (RelDecl.map_constr (liftn (-1) 1) p)
+	  (mkLambda_or_LetIn (RelDecl.map_constr (liftn (-1) 2) hp)
+	    (mkLambda_or_LetIn (RelDecl.map_constr (lift 2) ind)
 	      (Reductionops.whd_beta Evd.empty
 		(applist (c,
 	          Context.Rel.to_extended_list 3 indargs @ [mkRel 1;mkRel 3;mkRel 2]))))))
@@ -741,7 +743,7 @@ let build_congr env (eq,refl,ctx) ind =
   if List.exists is_local_def realsign then
     error "Inductive equalities with local definitions in arity not supported.";
   let env_with_arity = push_rel_context arityctxt env in
-  let ty = get_type (lookup_rel (mip.mind_nrealargs - i + 1) env_with_arity) in
+  let ty = RelDecl.get_type (lookup_rel (mip.mind_nrealargs - i + 1) env_with_arity) in
   let constrsign,ccl = decompose_prod_assum mip.mind_nf_lc.(0) in
   let _,constrargs = decompose_app ccl in
   if Int.equal (Context.Rel.length constrsign) (Context.Rel.length mib.mind_params_ctxt) then
diff --git a/tactics/equality.ml b/tactics/equality.ml
index 12d31d0f3..d44dcf10d 100644
--- a/tactics/equality.ml
+++ b/tactics/equality.ml
@@ -7,7 +7,7 @@
 (************************************************************************)
 
 open Pp
-open Errors
+open CErrors
 open Util
 open Names
 open Nameops
@@ -26,7 +26,6 @@ open Retyping
 open Tacmach.New
 open Logic
 open Hipattern
-open Tacexpr
 open Tacticals.New
 open Tactics
 open Tacred
@@ -45,6 +44,8 @@ open Proofview.Notations
 open Unification
 open Context.Named.Declaration
 
+module NamedDecl = Context.Named.Declaration
+
 (* Options *)
 
 let discriminate_introduction = ref true
@@ -72,11 +73,26 @@ let _ =
   declare_bool_option
     { optsync  = true;
       optdepr  = false;
-      optname  = "injection left-to-right pattern order";
+      optname  = "injection left-to-right pattern order and clear by default when with introduction pattern";
       optkey   = ["Injection";"L2R";"Pattern";"Order"];
       optread  = (fun () -> !injection_pattern_l2r_order) ;
       optwrite = (fun b -> injection_pattern_l2r_order := b) }
 
+let injection_in_context = ref false
+
+let use_injection_in_context () =
+  !injection_in_context
+  && Flags.version_strictly_greater Flags.V8_5
+
+let _ =
+  declare_bool_option
+    { optsync  = true;
+      optdepr  = false;
+      optname  = "injection in context";
+      optkey   = ["Structural";"Injection"];
+      optread  = (fun () -> !injection_in_context) ;
+      optwrite = (fun b -> injection_in_context := b) }
+
 (* Rewriting tactics *)
 
 let tclNOTSAMEGOAL tac =
@@ -344,7 +360,7 @@ let find_elim hdcncl lft2rgt dep cls ot gl =
 	      let _ = Global.lookup_constant c1' in
 		c1'
 	    with Not_found -> 
-	      errorlabstrm "Equality.find_elim"
+	      user_err ~hdr:"Equality.find_elim"
                 (str "Cannot find rewrite principle " ++ pr_label l' ++ str ".")
 	  end
 	| _ -> destConstRef pr1
@@ -385,7 +401,8 @@ let type_of_clause cls gl = match cls with
 
 let leibniz_rewrite_ebindings_clause cls lft2rgt tac c t l with_evars frzevars dep_proof_ok hdcncl =
   Proofview.Goal.nf_s_enter { s_enter = begin fun gl ->
-  let isatomic = isProd (whd_zeta hdcncl) in
+  let evd = Sigma.to_evar_map (Proofview.Goal.sigma gl) in
+  let isatomic = isProd (whd_zeta evd hdcncl) in
   let dep_fun = if isatomic then dependent else dependent_no_evar in
   let type_of_cls = type_of_clause cls gl in
   let dep = dep_proof_ok && dep_fun c type_of_cls in
@@ -613,7 +630,7 @@ let replace_using_leibniz clause c1 c2 l2r unsafe try_prove_eq_opt =
   in
   match evd with
   | None ->
-    tclFAIL 0 (str"Terms do not have convertible types.")
+    tclFAIL 0 (str"Terms do not have convertible types")
   | Some evd ->
     let e = build_coq_eq () in
     let sym = build_coq_eq_sym () in
@@ -685,16 +702,16 @@ let replace_in_clause_maybe_by c1 c2 cl tac_opt =
 exception DiscrFound of
   (constructor * int) list * constructor * constructor
 
-let injection_on_proofs = ref false
+let keep_proof_equalities_for_injection = ref false
 
 let _ =
   declare_bool_option
     { optsync  = true;
       optdepr  = false;
       optname  = "injection on prop arguments";
-      optkey   = ["Injection";"On";"Proofs"];
-      optread  = (fun () -> !injection_on_proofs) ;
-      optwrite = (fun b -> injection_on_proofs := b) }
+      optkey   = ["Keep";"Proof";"Equalities"];
+      optread  = (fun () -> !keep_proof_equalities_for_injection) ;
+      optwrite = (fun b -> keep_proof_equalities_for_injection := b) }
 
 
 let find_positions env sigma t1 t2 =
@@ -705,10 +722,10 @@ let find_positions env sigma t1 t2 =
     then [(List.rev posn,t1,t2)] else []
   in
   let rec findrec sorts posn t1 t2 =
-    let hd1,args1 = whd_betadeltaiota_stack env sigma t1 in
-    let hd2,args2 = whd_betadeltaiota_stack env sigma t2 in
+    let hd1,args1 = whd_all_stack env sigma t1 in
+    let hd2,args2 = whd_all_stack env sigma t2 in
     match (kind_of_term hd1, kind_of_term hd2) with
-      | Construct (sp1,_), Construct (sp2,_)
+      | Construct ((ind1,i1 as sp1),u1), Construct (sp2,_)
           when Int.equal (List.length args1) (constructor_nallargs_env env sp1)
             ->
 	  let sorts' =
@@ -717,11 +734,14 @@ let find_positions env sigma t1 t2 =
           (* both sides are fully applied constructors, so either we descend,
              or we can discriminate here. *)
 	  if eq_constructor sp1 sp2 then
-	    let nrealargs = constructor_nrealargs_env env sp1 in
-	    let rargs1 = List.lastn nrealargs args1 in
-	    let rargs2 = List.lastn nrealargs args2 in
+	    let nparams = inductive_nparams_env env ind1 in
+	    let params1,rargs1 = List.chop nparams args1 in
+	    let _,rargs2 = List.chop nparams args2 in
+            let (mib,mip) = lookup_mind_specif env ind1 in
+            let ctxt = (get_constructor ((ind1,u1),mib,mip,params1) i1).cs_args in
+            let adjust i = Vars.adjust_rel_to_rel_context ctxt (i+1) - 1 in
             List.flatten
-	      (List.map2_i (fun i -> findrec sorts' ((sp1,i)::posn))
+	      (List.map2_i (fun i -> findrec sorts' ((sp1,adjust i)::posn))
 		0 rargs1 rargs2)
 	  else if Sorts.List.mem InType sorts'
           then (* see build_discriminator *)
@@ -739,7 +759,7 @@ let find_positions env sigma t1 t2 =
 	    project env sorts posn t1_0 t2_0
   in
   try
-    let sorts = if !injection_on_proofs then [InSet;InType;InProp]
+    let sorts = if !keep_proof_equalities_for_injection then [InSet;InType;InProp]
 		else [InSet;InType]
     in
     Inr (findrec sorts [] t1 t2)
@@ -844,7 +864,7 @@ let descend_then env sigma head dirn =
         List.map build_branch
           (List.interval 1 (Array.length mip.mind_consnames)) in
       let ci = make_case_info env ind RegularStyle in
-      mkCase (ci, p, head, Array.of_list brl)))
+      Inductiveops.make_case_or_project env indf ci p head (Array.of_list brl)))
 
 (* Now we need to construct the discriminator, given a discriminable
    position.  This boils down to:
@@ -872,7 +892,7 @@ let build_selector env sigma dirn c ind special default =
           on (c bool true) = (c bool false)
           CP : changed assert false in a more informative error
        *)
-      errorlabstrm "Equality.construct_discriminator"
+      user_err ~hdr:"Equality.construct_discriminator"
 	(str "Cannot discriminate on inductive constructors with \
 		 dependent types.") in
   let (indp,_) = dest_ind_family indf in
@@ -958,7 +978,7 @@ let apply_on_clause (f,t) clause =
   let argmv =
     (match kind_of_term (last_arg f_clause.templval.Evd.rebus) with
      | Meta mv -> mv
-     | _  -> errorlabstrm "" (str "Ill-formed clause applicator.")) in
+     | _  -> user_err  (str "Ill-formed clause applicator.")) in
   clenv_fchain ~with_univs:false argmv f_clause clause
 
 let discr_positions env sigma (lbeq,eqn,(t,t1,t2)) eq_clause cpath dirn =
@@ -1036,7 +1056,7 @@ let discrEverywhere with_evars =
      else (* <= 8.2 compat *)
        tryAllHypsAndConcl (discrSimpleClause with_evars))
 (*    (fun gls ->
-       errorlabstrm "DiscrEverywhere" (str"No discriminable equalities."))
+       user_err ~hdr:"DiscrEverywhere" (str"No discriminable equalities."))
 *)
 let discr_tac with_evars = function
   | None -> discrEverywhere with_evars
@@ -1147,7 +1167,8 @@ let sig_clausal_form env sigma sort_of_ty siglen ty dflt =
       let dflt_typ = unsafe_type_of env sigma dflt in
       try
 	let () = evdref := Evarconv.the_conv_x_leq env dflt_typ p_i !evdref in
-	let () = evdref := Evarconv.consider_remaining_unif_problems env !evdref in
+	let () =
+          evdref := Evarconv.solve_unif_constraints_with_heuristics env !evdref in
 	dflt
       with Evarconv.UnableToUnify _ ->
 	error "Cannot solve a unification problem."
@@ -1268,7 +1289,7 @@ let build_injector env sigma dflt c cpath =
 
 (*
 let try_delta_expand env sigma t =
-  let whdt = whd_betadeltaiota env sigma t  in
+  let whdt = whd_all env sigma t  in
   let rec hd_rec c  =
     match kind_of_term c with
       | Construct _ -> whdt
@@ -1373,7 +1394,10 @@ let injEqThen tac l2r (eq,_,(t,t1,t2) as u) eq_clause =
   | Inl _ ->
      tclZEROMSG (strbrk"This equality is discriminable. You should use the discriminate tactic to solve the goal.")
   | Inr [] ->
-     let suggestion = if !injection_on_proofs then "" else " You can try to use option Set Injection On Proofs." in
+     let suggestion =
+         if !keep_proof_equalities_for_injection then
+            "" else
+            " You can try to use option Set Keep Proof Equalities." in
      tclZEROMSG (strbrk("No information can be deduced from this equality and the injectivity of constructors. This may be because the terms are convertible, or due to pattern matching restrictions in the sort Prop." ^ suggestion))
   | Inr [([],_,_)] when Flags.version_strictly_greater Flags.V8_3 ->
      tclZEROMSG (str"Nothing to inject.")
@@ -1381,34 +1405,52 @@ let injEqThen tac l2r (eq,_,(t,t1,t2) as u) eq_clause =
       inject_at_positions env sigma l2r u eq_clause posns
 	(tac (clenv_value eq_clause))
 
-let use_clear_hyp_by_default () = false
-
-let postInjEqTac clear_flag ipats c n =
-  match ipats with
-  | Some ipats ->
-      let clear_tac =
-        let dft =
-          use_injection_pattern_l2r_order () || use_clear_hyp_by_default () in
-        tclTRY (apply_clear_request clear_flag dft c) in
-      let intro_tac =
-        if use_injection_pattern_l2r_order ()
-        then intro_patterns_bound_to n MoveLast ipats
-        else intro_patterns_to MoveLast ipats in
-      tclTHEN clear_tac intro_tac
-  | None -> apply_clear_request clear_flag false c
-
-let injEq clear_flag ipats =
-  let l2r =
-    if use_injection_pattern_l2r_order () && not (Option.is_empty ipats) then true else false
+let get_previous_hyp_position id gl =
+  let rec aux dest = function
+  | [] -> raise (RefinerError (NoSuchHyp id))
+  | d :: right ->
+    let hyp = Context.Named.Declaration.get_id d in
+    if Id.equal hyp id then dest else aux (MoveAfter hyp) right
   in
-  injEqThen (fun c i -> postInjEqTac clear_flag ipats c i) l2r
-
-let inj ipats with_evars clear_flag = onEquality with_evars (injEq clear_flag ipats)
+  aux MoveLast (Proofview.Goal.hyps (Proofview.Goal.assume gl))
+
+let injEq ?(old=false) with_evars clear_flag ipats =
+  (* Decide which compatibility mode to use *)
+  let ipats_style, l2r, dft_clear_flag, bounded_intro = match ipats with
+    | None when not old && use_injection_in_context () ->
+      Some [], true, true, true
+    | None -> None, false, false, false
+    | _ -> let b = use_injection_pattern_l2r_order () in ipats, b, b, b in
+  (* Built the post tactic depending on compatibility mode *)
+  let post_tac c n =
+    match ipats_style with
+    | Some ipats ->
+      Proofview.Goal.enter { enter = begin fun gl ->
+        let destopt = match kind_of_term c with
+        | Var id -> get_previous_hyp_position id gl
+        | _ -> MoveLast in
+        let clear_tac =
+          tclTRY (apply_clear_request clear_flag dft_clear_flag c) in
+        (* Try should be removal if dependency were treated *)
+        let intro_tac =
+          if bounded_intro
+          then intro_patterns_bound_to with_evars n destopt ipats
+          else intro_patterns_to with_evars destopt ipats in
+        tclTHEN clear_tac intro_tac
+      end }
+    | None -> tclIDTAC in
+  injEqThen post_tac l2r
+
+let inj ipats with_evars clear_flag = onEquality with_evars (injEq with_evars clear_flag ipats)
 
 let injClause ipats with_evars = function
-  | None -> onNegatedEquality with_evars (injEq None ipats)
+  | None -> onNegatedEquality with_evars (injEq with_evars None ipats)
   | Some c -> onInductionArg (inj ipats with_evars) c
 
+let simpleInjClause with_evars = function
+  | None -> onNegatedEquality with_evars (injEq ~old:true with_evars None None)
+  | Some c -> onInductionArg (fun clear_flag -> onEquality with_evars (injEq ~old:true with_evars clear_flag None)) c
+
 let injConcl = injClause None false None
 let injHyp clear_flag id = injClause None false (Some (clear_flag,ElimOnIdent (Loc.ghost,id)))
 
@@ -1434,13 +1476,13 @@ let dEq with_evars =
   dEqThen with_evars (fun clear_flag c x ->
     (apply_clear_request clear_flag (use_clear_hyp_by_default ()) c))
 
-let intro_decompe_eq tac data cl =
+let intro_decomp_eq tac data cl =
   Proofview.Goal.enter { enter = begin fun gl ->
     let cl = pf_apply make_clenv_binding gl cl NoBindings in
     decompEqThen (fun _ -> tac) data cl
   end }
 
-let _ = declare_intro_decomp_eq intro_decompe_eq
+let _ = declare_intro_decomp_eq intro_decomp_eq
 
 (* [subst_tuple_term dep_pair B]
 
@@ -1628,12 +1670,16 @@ exception FoundHyp of (Id.t * constr * bool)
 
 (* tests whether hyp [c] is [x = t] or [t = x], [x] not occurring in [t] *)
 let is_eq_x gl x d =
-  let id = get_id d in
+  let id = NamedDecl.get_id d in
   try
-    let c = pf_nf_evar gl (get_type d) in
+    let is_var id c = match kind_of_term c with
+    | Var id' -> Id.equal id id'
+    | _ -> false
+    in
+    let c = pf_nf_evar gl (NamedDecl.get_type d) in
     let (_,lhs,rhs) = pi3 (find_eq_data_decompose gl c) in
-    if (Term.eq_constr x lhs) && not (occur_term x rhs) then raise (FoundHyp (id,rhs,true));
-    if (Term.eq_constr x rhs) && not (occur_term x lhs) then raise (FoundHyp (id,lhs,false))
+    if (is_var x lhs) && not (local_occur_var x rhs) then raise (FoundHyp (id,rhs,true));
+    if (is_var x rhs) && not (local_occur_var x lhs) then raise (FoundHyp (id,lhs,false))
   with Constr_matching.PatternMatchingFailure ->
     ()
 
@@ -1648,12 +1694,12 @@ let subst_one dep_proof_ok x (hyp,rhs,dir) =
   (* The set of hypotheses using x *)
   let dephyps =
     List.rev (pi3 (List.fold_right (fun dcl (dest,deps,allhyps) ->
-      let id = get_id dcl in
+      let id = NamedDecl.get_id dcl in
       if not (Id.equal id hyp)
          && List.exists (fun y -> occur_var_in_decl env y dcl) deps
       then
         let id_dest = if !regular_subst_tactic then dest else MoveLast in
-        (dest,(if is_local_assum dcl then deps else id::deps), (id_dest,id)::allhyps)
+        (dest,id::deps,(id_dest,id)::allhyps)
       else
         (MoveBefore id,deps,allhyps))
       hyps
@@ -1677,19 +1723,17 @@ let subst_one dep_proof_ok x (hyp,rhs,dir) =
 let subst_one_var dep_proof_ok x =
   Proofview.Goal.enter { enter = begin fun gl ->
     let gl = Proofview.Goal.assume gl in
-    let xval = pf_get_hyp x gl |> get_value in
+    let decl = pf_get_hyp x gl in
     (* If x has a body, simply replace x with body and clear x *)
-    if not (Option.is_empty xval) then tclTHEN (unfold_body x) (clear [x]) else
-      (* x is a variable: *)
-      let varx = mkVar x in
+    if is_local_def decl then tclTHEN (unfold_body x) (clear [x]) else
       (* Find a non-recursive definition for x *)
       let res =
         try
           (** [is_eq_x] ensures nf_evar on its side *)
           let hyps = Proofview.Goal.hyps gl in
-          let test hyp _ = is_eq_x gl varx hyp in
+          let test hyp _ = is_eq_x gl x hyp in
           Context.Named.fold_outside test ~init:() hyps;
-          errorlabstrm "Subst"
+          user_err ~hdr:"Subst"
             (str "Cannot find any non-recursive equality over " ++ pr_id x ++
 	       str".")
         with FoundHyp res -> res in
@@ -1697,7 +1741,7 @@ let subst_one_var dep_proof_ok x =
   end }
 
 let subst_gen dep_proof_ok ids =
-  tclTHEN Proofview.V82.nf_evar_goals (tclMAP (subst_one_var dep_proof_ok) ids)
+  tclMAP (subst_one_var dep_proof_ok) ids
 
 (* For every x, look for an hypothesis hyp of the form "x=rhs" or "rhs=x",
    rewrite it everywhere, and erase hyp and x; proceed by generalizing
@@ -1725,35 +1769,38 @@ let subst_all ?(flags=default_subst_tactic_flags ()) () =
     let gl = Proofview.Goal.assume gl in
     let env = Proofview.Goal.env gl in
     let find_eq_data_decompose = find_eq_data_decompose gl in
-    let test decl =
+    let select_equation_name decl =
       try
-        let lbeq,u,(_,x,y) = find_eq_data_decompose (get_type decl) in
+        let lbeq,u,(_,x,y) = find_eq_data_decompose (NamedDecl.get_type decl) in
         let eq = Universes.constr_of_global_univ (lbeq.eq,u) in
         if flags.only_leibniz then restrict_to_eq_and_identity eq;
         match kind_of_term x, kind_of_term y with
-        | Var z, _ | _, Var z when not (is_evaluable env (EvalVarRef z))  ->
-            Some (get_id decl)
+        | Var z, _  when not (is_evaluable env (EvalVarRef z)) ->
+            Some (NamedDecl.get_id decl)
+        | _, Var z when not (is_evaluable env (EvalVarRef z)) ->
+            Some (NamedDecl.get_id decl)
         | _ ->
             None
       with Constr_matching.PatternMatchingFailure -> None
     in
     let hyps = Proofview.Goal.hyps gl in
-    List.rev (List.map_filter test hyps)
+    List.rev (List.map_filter select_equation_name hyps)
   in
 
   (* Second step: treat equations *)
   let process hyp =
     Proofview.Goal.enter { enter = begin fun gl ->
     let gl = Proofview.Goal.assume gl in
+    let env = Proofview.Goal.env gl in
     let find_eq_data_decompose = find_eq_data_decompose gl in
-    let c = pf_get_hyp hyp gl |> get_type in
+    let c = pf_get_hyp hyp gl |> NamedDecl.get_type in
     let _,_,(_,x,y) = find_eq_data_decompose c in
     (* J.F.: added to prevent failure on goal containing x=x as an hyp *)
     if Term.eq_constr x y then Proofview.tclUNIT () else
       match kind_of_term x, kind_of_term y with
-      | Var x', _ when not (occur_term x y) ->
+      | Var x', _ when not (occur_term x y) && not (is_evaluable env (EvalVarRef x')) ->
           subst_one flags.rewrite_dependent_proof x' (hyp,y,true)
-      | _, Var y' when not (occur_term y x) ->
+      | _, Var y' when not (occur_term y x) && not (is_evaluable env (EvalVarRef y')) ->
           subst_one flags.rewrite_dependent_proof y' (hyp,x,false)
       | _ ->
           Proofview.tclUNIT ()
@@ -1815,10 +1862,10 @@ let rewrite_assumption_cond cond_eq_term cl =
   let rec arec hyps gl = match hyps with
     | [] -> error "No such assumption."
     | hyp ::rest ->
-        let id = get_id hyp in
+        let id = NamedDecl.get_id hyp in
 	begin
 	  try
-            let dir = cond_eq_term (get_type hyp) gl in
+            let dir = cond_eq_term (NamedDecl.get_type hyp) gl in
 	    general_rewrite_clause dir false (mkVar id,NoBindings) cl
 	  with | Failure _ | UserError _ -> arec rest gl
 	end
diff --git a/tactics/equality.mli b/tactics/equality.mli
index 458d8f372..6a4a8126e 100644
--- a/tactics/equality.mli
+++ b/tactics/equality.mli
@@ -11,10 +11,10 @@ open Names
 open Term
 open Evd
 open Environ
-open Tacexpr
 open Ind_tables
 open Locus
 open Misctypes
+open Tactypes
 (*i*)
 
 type dep_proof_flag = bool (* true = support rewriting dependent proofs *)
@@ -72,16 +72,18 @@ val discrConcl   : unit Proofview.tactic
 val discrHyp     : Id.t -> unit Proofview.tactic
 val discrEverywhere : evars_flag -> unit Proofview.tactic
 val discr_tac    : evars_flag ->
-  constr with_bindings induction_arg option -> unit Proofview.tactic
+  constr with_bindings destruction_arg option -> unit Proofview.tactic
 val inj          : intro_patterns option -> evars_flag ->
   clear_flag -> constr with_bindings -> unit Proofview.tactic
 val injClause    : intro_patterns option -> evars_flag ->
-  constr with_bindings induction_arg option -> unit Proofview.tactic
+  constr with_bindings destruction_arg option -> unit Proofview.tactic
 val injHyp       : clear_flag -> Id.t -> unit Proofview.tactic
 val injConcl     : unit Proofview.tactic
+val simpleInjClause : evars_flag ->
+  constr with_bindings destruction_arg option -> unit Proofview.tactic
 
-val dEq : evars_flag -> constr with_bindings induction_arg option -> unit Proofview.tactic
-val dEqThen : evars_flag -> (clear_flag -> constr -> int -> unit Proofview.tactic) -> constr with_bindings induction_arg option -> unit Proofview.tactic
+val dEq : evars_flag -> constr with_bindings destruction_arg option -> unit Proofview.tactic
+val dEqThen : evars_flag -> (clear_flag -> constr -> int -> unit Proofview.tactic) -> constr with_bindings destruction_arg option -> unit Proofview.tactic
 
 val make_iterated_tuple :
   env -> evar_map -> constr -> (constr * types) -> evar_map * (constr * constr * constr)
diff --git a/tactics/hints.ml b/tactics/hints.ml
index 6f8da00d8..59d015fa2 100644
--- a/tactics/hints.ml
+++ b/tactics/hints.ml
@@ -8,7 +8,7 @@
 
 open Pp
 open Util
-open Errors
+open CErrors
 open Names
 open Vars
 open Term
@@ -20,11 +20,11 @@ open Namegen
 open Libnames
 open Smartlocate
 open Misctypes
+open Tactypes
 open Evd
 open Termops
 open Inductiveops
 open Typing
-open Tacexpr
 open Decl_kinds
 open Pattern
 open Patternops
@@ -34,12 +34,15 @@ open Tacred
 open Printer
 open Vernacexpr
 open Sigma.Notations
-open Context.Named.Declaration
+
+module NamedDecl = Context.Named.Declaration
 
 (****************************************)
 (* General functions                    *)
 (****************************************)
 
+type debug = Debug | Info | Off
+
 exception Bound
 
 let head_constr_bound t =
@@ -66,6 +69,29 @@ let decompose_app_bound t =
     | Proj (p, c) -> ConstRef (Projection.constant p), Array.cons c args
     | _ -> raise Bound
 
+(** Compute the set of section variables that remain in the named context.
+    Starts from the top to the bottom of the context, stops at the first
+    different declaration between the named hyps and the section context. *)
+let secvars_of_hyps hyps =
+  let secctx = Global.named_context () in
+  let open Context.Named.Declaration in
+  let pred, all =
+    List.fold_left (fun (pred,all) decl ->
+        try let _ = Context.Named.lookup (get_id decl) hyps in
+          (* Approximation, it might be an hypothesis reintroduced with same name and unconvertible types,
+             we must allow it currently, as comparing the declarations for syntactic equality is too
+             strong a check (e.g. an unfold in a section variable would make it unusable). *)
+          (Id.Pred.add (get_id decl) pred, all)
+        with Not_found -> (pred, false))
+      (Id.Pred.empty,true) secctx
+  in
+  if all then Id.Pred.full (* If the whole section context is available *)
+  else pred
+
+let empty_hint_info =
+  let open Vernacexpr in
+  { hint_priority = None; hint_pattern = None }
+
 (************************************************************************)
 (*           The Type of Constructions Autotactic Hints                 *)
 (************************************************************************)
@@ -78,18 +104,25 @@ type 'a hint_ast =
   | Unfold_nth of evaluable_global_reference       (* Hint Unfold *)
   | Extern     of Genarg.glob_generic_argument (* Hint Extern *)
 
-type hints_path_atom = 
-  | PathHints of global_reference list
+
+type 'a hints_path_atom_gen =
+  | PathHints of 'a list
+  (* For forward hints, their names is the list of projections *)
   | PathAny
 
-type hints_path =
-  | PathAtom of hints_path_atom
-  | PathStar of hints_path
-  | PathSeq of hints_path * hints_path
-  | PathOr of hints_path * hints_path
+type hints_path_atom = global_reference hints_path_atom_gen
+
+type 'a hints_path_gen =
+  | PathAtom of 'a hints_path_atom_gen
+  | PathStar of 'a hints_path_gen
+  | PathSeq of 'a hints_path_gen * 'a hints_path_gen
+  | PathOr of 'a hints_path_gen * 'a hints_path_gen
   | PathEmpty
   | PathEpsilon
 
+type pre_hints_path = Libnames.reference hints_path_gen
+type hints_path = global_reference hints_path_gen
+
 type hint_term =
   | IsGlobRef of global_reference
   | IsConstr of constr * Univ.universe_context_set
@@ -104,11 +137,13 @@ type raw_hint = constr * types * Univ.universe_context_set
 type hint = (raw_hint * clausenv) hint_ast with_uid
 
 type 'a with_metadata = {
-  pri  : int;            (* A number lower is higher priority *)
-  poly  : polymorphic;    (** Is the hint polymorpic and hence should be refreshed at each application *)
-  pat  : constr_pattern option; (* A pattern for the concl of the Goal *)
-  name  : hints_path_atom; (* A potential name to refer to the hint *) 
-  code : 'a;     (* the tactic to apply when the concl matches pat *)
+  pri     : int;            (* A number lower is higher priority *)
+  poly    : polymorphic;    (** Is the hint polymorpic and hence should be refreshed at each application *)
+  pat     : constr_pattern option; (* A pattern for the concl of the Goal *)
+  name    : hints_path_atom; (* A potential name to refer to the hint *)
+  db : string option; (** The database from which the hint comes *)
+  secvars : Id.Pred.t; (* The set of section variables the hint depends on *)
+  code    : 'a;     (* the tactic to apply when the concl matches pat *)
 }
 
 type full_hint = hint with_metadata
@@ -189,7 +224,7 @@ type search_entry = {
   sentry_nopat : stored_data list;
   sentry_pat : stored_data list;
   sentry_bnet : Bounded_net.t;
-  sentry_mode : bool array list;
+  sentry_mode : hint_mode array list;
 }
 
 let empty_se = {
@@ -317,6 +352,12 @@ let rec is_empty = function
   | PathEmpty -> true
   | PathEpsilon -> false
 
+let path_seq p p' =
+  match p, p' with
+  | PathEpsilon, p' -> p'
+  | p, PathEpsilon -> p
+  | p, p' -> PathSeq (p, p')
+                    
 let rec path_derivate hp hint =
   let rec derivate_atoms hints hints' =
     match hints, hints' with
@@ -324,26 +365,26 @@ let rec path_derivate hp hint =
     | [], [] -> PathEpsilon
     | [], hints -> PathEmpty
     | grs, [] -> PathAtom (PathHints grs)
-    | _, _ -> PathEmpty 
+    | _, _ -> PathEmpty
   in
-    match hp with
-    | PathAtom PathAny -> PathEpsilon
-    | PathAtom (PathHints grs) -> 
-      (match grs, hint with
-       | h :: hints, PathAny -> PathEmpty
-       | hints, PathHints hints' -> derivate_atoms hints hints'
-       | _, _ -> assert false)
-    | PathStar p -> if path_matches p [hint] then hp else PathEpsilon
-    | PathSeq (hp, hp') ->
-      let hpder = path_derivate hp hint in
-	if matches_epsilon hp then 
-	  PathOr (PathSeq (hpder, hp'), path_derivate hp' hint)
-	else if is_empty hpder then PathEmpty 
-	else PathSeq (hpder, hp')
-    | PathOr (hp, hp') ->
-      PathOr (path_derivate hp hint, path_derivate hp' hint)
-    | PathEmpty -> PathEmpty
-    | PathEpsilon -> PathEmpty
+  match hp with
+  | PathAtom PathAny -> PathEpsilon
+  | PathAtom (PathHints grs) -> 
+     (match grs, hint with
+      | h :: _, PathAny -> PathEmpty
+      | hints, PathHints hints' -> derivate_atoms hints hints'
+      | _, _ -> assert false)
+  | PathStar p -> if path_matches p [hint] then hp else PathEpsilon
+  | PathSeq (hp, hp') ->
+     let hpder = path_derivate hp hint in
+     if matches_epsilon hp then 
+       PathOr (path_seq hpder hp', path_derivate hp' hint)
+     else if is_empty hpder then PathEmpty 
+     else path_seq hpder hp'
+  | PathOr (hp, hp') ->
+     PathOr (path_derivate hp hint, path_derivate hp' hint)
+  | PathEmpty -> PathEmpty
+  | PathEpsilon -> PathEmpty
 
 let rec normalize_path h =
   match h with
@@ -363,19 +404,40 @@ let rec normalize_path h =
 
 let path_derivate hp hint = normalize_path (path_derivate hp hint)
 
-let pp_hints_path_atom a =
+let pp_hints_path_atom prg a =
   match a with
-  | PathAny -> str"*"
-  | PathHints grs -> pr_sequence pr_global grs
-					   
-let rec pp_hints_path = function
-  | PathAtom pa -> pp_hints_path_atom pa
-  | PathStar p -> str "!(" ++ pp_hints_path p ++ str")"
-  | PathSeq (p, p') -> pp_hints_path p ++ str" ; " ++ pp_hints_path p'
-  | PathOr (p, p') -> 
-    str "(" ++ pp_hints_path p ++ spc () ++ str"|" ++ spc () ++ pp_hints_path p' ++ str ")"
+  | PathAny -> str"_"
+  | PathHints grs -> pr_sequence prg grs
+
+let pp_hints_path_gen prg =
+  let rec aux = function
+    | PathAtom pa -> pp_hints_path_atom prg pa
+    | PathStar (PathAtom PathAny) -> str"_*"
+    | PathStar p -> str "(" ++ aux p ++ str")*"
+    | PathSeq (p, p') -> aux p ++ spc () ++ aux p'
+    | PathOr (p, p') -> 
+     str "(" ++ aux p ++ spc () ++ str"|" ++ cut () ++ spc () ++
+     aux p' ++ str ")"
   | PathEmpty -> str"emp"
   | PathEpsilon -> str"eps"
+  in aux
+     
+let pp_hints_path = pp_hints_path_gen pr_global
+
+let glob_hints_path_atom p =
+  match p with
+  | PathHints g -> PathHints (List.map Nametab.global g)
+  | PathAny -> PathAny
+
+let glob_hints_path =
+  let rec aux = function
+    | PathAtom pa -> PathAtom (glob_hints_path_atom pa)
+    | PathStar p -> PathStar (aux p)
+    | PathSeq (p, p') -> PathSeq (aux p, aux p')
+    | PathOr (p, p') -> PathOr (aux p, aux p')
+    | PathEmpty -> PathEmpty
+    | PathEpsilon -> PathEpsilon
+  in aux
 
 let subst_path_atom subst p =
   match p with
@@ -402,7 +464,38 @@ let rec subst_hints_path subst hp =
       if p' == p && q' == q then hp else PathOr (p', q')
   | _ -> hp
 
-module Hint_db = struct
+type hint_db_name = string
+
+module Hint_db :
+sig
+type t
+val empty : ?name:hint_db_name -> transparent_state -> bool -> t
+val find : global_reference -> t -> search_entry
+val map_none : secvars:Id.Pred.t -> t -> full_hint list
+val map_all : secvars:Id.Pred.t -> global_reference -> t -> full_hint list
+val map_existential : secvars:Id.Pred.t ->
+		      (global_reference * constr array) -> constr -> t -> full_hint list
+val map_eauto : secvars:Id.Pred.t ->
+		(global_reference * constr array) -> constr -> t -> full_hint list
+val map_auto : secvars:Id.Pred.t ->
+	       (global_reference * constr array) -> constr -> t -> full_hint list
+val add_one : env -> evar_map -> hint_entry -> t -> t
+val add_list : env -> evar_map -> hint_entry list -> t -> t
+val remove_one : global_reference -> t -> t
+val remove_list : global_reference list -> t -> t
+val iter : (global_reference option -> hint_mode array list -> full_hint list -> unit) -> t -> unit
+val use_dn : t -> bool
+val transparent_state : t -> transparent_state
+val set_transparent_state : t -> transparent_state -> t
+val add_cut : hints_path -> t -> t
+val add_mode : global_reference -> hint_mode array -> t -> t
+val cut : t -> hints_path
+val unfolds : t -> Id.Set.t * Cset.t
+val fold : (global_reference option -> hint_mode array list -> full_hint list -> 'a -> 'a) ->
+  t -> 'a -> 'a
+
+end =
+struct
 
   type t = {
     hintdb_state : Names.transparent_state;
@@ -413,69 +506,83 @@ module Hint_db = struct
     hintdb_map : search_entry Constr_map.t;
     (* A list of unindexed entries starting with an unfoldable constant
        or with no associated pattern. *)
-    hintdb_nopat : (global_reference option * stored_data) list
+    hintdb_nopat : (global_reference option * stored_data) list;
+    hintdb_name : string option;
   }
 
   let next_hint_id db =
     let h = db.hintdb_max_id in
     { db with hintdb_max_id = succ db.hintdb_max_id }, h
 
-  let empty st use_dn = { hintdb_state = st;
+  let empty ?name st use_dn = { hintdb_state = st;
 			  hintdb_cut = PathEmpty;
 			  hintdb_unfolds = (Id.Set.empty, Cset.empty);
 			  hintdb_max_id = 0;
 			  use_dn = use_dn;
 			  hintdb_map = Constr_map.empty;
-			  hintdb_nopat = [] }
+			  hintdb_nopat = [];
+			  hintdb_name = name; }
 
   let find key db =
     try Constr_map.find key db.hintdb_map
     with Not_found -> empty_se
  
-  let realize_tac (id,tac) = tac
-
+  let realize_tac secvars (id,tac) =
+    if Id.Pred.subset tac.secvars secvars then Some tac
+    else
+      (** Warn about no longer typable hint? *)
+      None
+
+  let match_mode m arg =
+    match m with
+    | ModeInput -> not (occur_existential arg)
+    | ModeNoHeadEvar ->
+       Evarutil.(try ignore(head_evar arg); false
+                 with NoHeadEvar -> true)
+    | ModeOutput -> true
+                               
   let matches_mode args mode =
-    Array.length args == Array.length mode &&
-      Array.for_all2 (fun arg m -> not (m && occur_existential arg)) args mode
+    Array.length mode == Array.length args &&
+      Array.for_all2 match_mode mode args
       
   let matches_modes args modes =
     if List.is_empty modes then true
     else List.exists (matches_mode args) modes
 
-  let merge_entry db nopat pat =
+  let merge_entry secvars db nopat pat =
     let h = List.sort pri_order_int (List.map snd db.hintdb_nopat) in
     let h = List.merge pri_order_int h nopat in
     let h = List.merge pri_order_int h pat in
-    List.map realize_tac h
+    List.map_filter (realize_tac secvars) h
 
-  let map_none db =
-    merge_entry db [] []
+  let map_none ~secvars db =
+    merge_entry secvars db [] []
 
-  let map_all k db =
+  let map_all ~secvars k db =
     let se = find k db in
-    merge_entry db se.sentry_nopat se.sentry_pat
+    merge_entry secvars db se.sentry_nopat se.sentry_pat
 	
   (** Precondition: concl has no existentials *)
-  let map_auto (k,args) concl db =
+  let map_auto ~secvars (k,args) concl db =
     let se = find k db in
     let st = if db.use_dn then  (Some db.hintdb_state) else None in
     let pat = lookup_tacs concl st se in
-    merge_entry db [] pat
+    merge_entry secvars db [] pat
 
-  let map_existential (k,args) concl db =
+  let map_existential ~secvars (k,args) concl db =
     let se = find k db in
       if matches_modes args se.sentry_mode then
-        merge_entry db se.sentry_nopat se.sentry_pat
-      else merge_entry db [] []
+        merge_entry secvars db se.sentry_nopat se.sentry_pat
+      else merge_entry secvars db [] []
 
   (* [c] contains an existential *)
-  let map_eauto (k,args) concl db =
+  let map_eauto ~secvars (k,args) concl db =
     let se = find k db in
       if matches_modes args se.sentry_mode then
         let st = if db.use_dn then Some db.hintdb_state else None in
         let pat = lookup_tacs concl st se in
-        merge_entry db [] pat
-      else merge_entry db [] []
+        merge_entry secvars db [] pat
+      else merge_entry secvars db [] []
 
   let is_exact = function
     | Give_exact _ -> true
@@ -486,7 +593,7 @@ module Hint_db = struct
     | _ -> false
 
   let addkv gr id v db =
-    let idv = id, v in
+    let idv = id, { v with db = db.hintdb_name } in
     let k = match gr with
       | Some gr -> if db.use_dn && is_transparent_gr db.hintdb_state gr &&
 	  is_unfold v.code.obj then None else Some gr
@@ -551,11 +658,11 @@ module Hint_db = struct
 
   let get_entry se =
     let h = List.merge pri_order_int se.sentry_nopat se.sentry_pat in
-    List.map realize_tac h
+    List.map snd h
 
   let iter f db =
     let iter_se k se = f (Some k) se.sentry_mode (get_entry se) in
-    f None [] (List.map (fun x -> realize_tac (snd x)) db.hintdb_nopat);
+    f None [] (List.map (fun x -> snd (snd x)) db.hintdb_nopat);
     Constr_map.iter iter_se db.hintdb_map
 
   let fold f db accu =
@@ -590,8 +697,6 @@ type hint_db = Hint_db.t
 
 type hint_db_table = hint_db Hintdbmap.t ref
 
-type hint_db_name = string
-
 (** Initially created hint databases, for typeclasses and rewrite *)
 
 let typeclasses_db = "typeclass_instances"
@@ -612,11 +717,10 @@ let searchtable_add (name,db) =
 let current_db_names () = Hintdbmap.domain !searchtable
 let current_db () = Hintdbmap.bindings !searchtable
 
-let current_pure_db () =
-  List.map snd (Hintdbmap.bindings (Hintdbmap.remove "v62" !searchtable))
+let current_pure_db () = List.map snd (current_db ())
 
 let error_no_such_hint_database x =
-  errorlabstrm "Hints" (str "No such Hint database: " ++ str x ++ str ".")
+  user_err ~hdr:"Hints" (str "No such Hint database: " ++ str x ++ str ".")
 
 (**************************************************************************)
 (*                       Definition of the summary                        *)
@@ -653,7 +757,20 @@ let try_head_pattern c =
 
 let with_uid c = { obj = c; uid = fresh_key () }
 
-let make_exact_entry env sigma pri poly ?(name=PathAny) (c, cty, ctx) =
+let secvars_of_idset s =
+  Id.Set.fold (fun id p ->
+      if is_section_variable id then
+        Id.Pred.add id p
+      else p) s Id.Pred.empty
+
+let secvars_of_constr env c =
+  secvars_of_idset (global_vars_set env c)
+
+let secvars_of_global env gr =
+  secvars_of_idset (vars_of_global_reference env gr)
+
+let make_exact_entry env sigma info poly ?(name=PathAny) (c, cty, ctx) =
+  let secvars = secvars_of_constr env c in
   let cty = strip_outer_cast cty in
     match kind_of_term cty with
     | Prod _ -> failwith "make_exact_entry"
@@ -663,14 +780,17 @@ let make_exact_entry env sigma pri poly ?(name=PathAny) (c, cty, ctx) =
 	  try head_pattern_bound pat
 	  with BoundPattern -> failwith "make_exact_entry"
 	in
-          (Some hd,
-	  { pri = (match pri with None -> 0 | Some p -> p);
-	    poly = poly;
-	    pat = Some pat;
-	    name = name;
-	    code = with_uid (Give_exact (c, cty, ctx)); })
+	let pri = match info.hint_priority with None -> 0 | Some p -> p in
+	let pat = match info.hint_pattern with
+	| Some pat -> snd pat
+	| None -> pat
+	in
+        (Some hd,
+	 { pri; poly; pat = Some pat; name;
+	   db = None; secvars;
+	   code = with_uid (Give_exact (c, cty, ctx)); })
 
-let make_apply_entry env sigma (eapply,hnf,verbose) pri poly ?(name=PathAny) (c, cty, ctx) =
+let make_apply_entry env sigma (eapply,hnf,verbose) info poly ?(name=PathAny) (c, cty, ctx) =
   let cty = if hnf then hnf_constr env sigma cty else cty in
     match kind_of_term cty with
     | Prod _ ->
@@ -682,23 +802,25 @@ let make_apply_entry env sigma (eapply,hnf,verbose) pri poly ?(name=PathAny) (c,
 	  try head_pattern_bound pat
           with BoundPattern -> failwith "make_apply_entry" in
         let nmiss = List.length (clenv_missing ce) in
+        let secvars = secvars_of_constr env c in
+	let pri = match info.hint_priority with None -> nb_hyp cty + nmiss | Some p -> p in
+	let pat = match info.hint_pattern with
+	| Some p -> snd p | None -> pat
+	in
 	if Int.equal nmiss 0 then
 	  (Some hd,
-          { pri = (match pri with None -> nb_hyp cty | Some p -> p);
-	    poly = poly;
-            pat = Some pat;
-	    name = name;
+          { pri; poly; pat = Some pat; name;
+            db = None;
+            secvars;
             code = with_uid (Res_pf(c,cty,ctx)); })
 	else begin
 	  if not eapply then failwith "make_apply_entry";
           if verbose then
-	    Feedback.msg_warning (str "the hint: eapply " ++ pr_lconstr c ++
+	    Feedback.msg_info (str "the hint: eapply " ++ pr_lconstr c ++
 	    str " will only be used by eauto");
           (Some hd,
-           { pri = (match pri with None -> nb_hyp cty + nmiss | Some p -> p);
-	     poly = poly;
-             pat = Some pat;
-	     name = name;
+           { pri; poly; pat = Some pat; name;
+	     db = None; secvars;
              code = with_uid (ERes_pf(c,cty,ctx)); })
         end
     | _ -> failwith "make_apply_entry"
@@ -727,6 +849,12 @@ let input_context_set : Univ.ContextSet.t -> Libobject.obj =
       discharge_function = (fun (_,a) -> Some a);
       classify_function = (fun a -> Keep a) }
 
+let warn_polymorphic_hint =
+  CWarnings.create ~name:"polymorphic-hint" ~category:"automation"
+         (fun hint -> strbrk"Using polymorphic hint " ++ hint ++
+                        str" monomorphically" ++
+                        strbrk" use Polymorphic Hint to use it polymorphically.")
+
 let fresh_global_or_constr env sigma poly cr =
   let isgr, (c, ctx) =
     match cr with
@@ -738,23 +866,22 @@ let fresh_global_or_constr env sigma poly cr =
     else if Univ.ContextSet.is_empty ctx then (c, ctx)
     else begin
       if isgr then
-        Feedback.msg_warning (str"Using polymorphic hint " ++
-		     pr_hint_term env sigma ctx cr ++ str" monomorphically" ++
-		     str" use Polymorphic Hint to use it polymorphically.");
+        warn_polymorphic_hint (pr_hint_term env sigma ctx cr);
       Lib.add_anonymous_leaf (input_context_set ctx);
       (c, Univ.ContextSet.empty)
     end
 
-let make_resolves env sigma flags pri poly ?name cr =
+let make_resolves env sigma flags info poly ?name cr =
   let c, ctx = fresh_global_or_constr env sigma poly cr in
   let cty = Retyping.get_type_of env sigma c in
   let try_apply f =
     try Some (f (c, cty, ctx)) with Failure _ -> None in
   let ents = List.map_filter try_apply
-    [make_exact_entry env sigma pri poly ?name; make_apply_entry env sigma flags pri poly ?name]
+			     [make_exact_entry env sigma info poly ?name;
+			      make_apply_entry env sigma flags info poly ?name]
   in
   if List.is_empty ents then
-    errorlabstrm "Hint"
+    user_err ~hdr:"Hint"
       (pr_lconstr c ++ spc() ++
         (if pi1 flags then str"cannot be used as a hint."
 	else str "can be used as a hint only for eauto."));
@@ -762,16 +889,18 @@ let make_resolves env sigma flags pri poly ?name cr =
 
 (* used to add an hypothesis to the local hint database *)
 let make_resolve_hyp env sigma decl =
-  let hname = get_id decl in
+  let hname = NamedDecl.get_id decl in
+  let c = mkVar hname in
   try
-    [make_apply_entry env sigma (true, true, false) None false
+    [make_apply_entry env sigma (true, true, false) empty_hint_info false
        ~name:(PathHints [VarRef hname])
-       (mkVar hname, get_type decl, Univ.ContextSet.empty)]
+       (c, NamedDecl.get_type decl, Univ.ContextSet.empty)]
   with
     | Failure _ -> []
     | e when Logic.catchable_exception e -> anomaly (Pp.str "make_resolve_hyp")
 
 (* REM : in most cases hintname = id *)
+
 let make_unfold eref =
   let g = global_of_evaluable_reference eref in
   (Some g,
@@ -779,16 +908,19 @@ let make_unfold eref =
      poly = false;
      pat = None;
      name = PathHints [g];
+     db = None;
+     secvars = secvars_of_global (Global.env ()) g;
      code = with_uid (Unfold_nth eref) })
 
 let make_extern pri pat tacast =
-  let tacast = Genarg.in_gen (Genarg.glbwit Constrarg.wit_ltac) tacast in
   let hdconstr = Option.map try_head_pattern pat in
   (hdconstr,
    { pri = pri;
      poly = false;
      pat = pat;
      name = PathAny;
+     db = None;
+     secvars = Id.Pred.empty; (* Approximation *)
      code = with_uid (Extern tacast) })  
 
 let make_mode ref m = 
@@ -797,7 +929,7 @@ let make_mode ref m =
   let n = List.length ctx in
   let m' = Array.of_list m in
     if not (n == Array.length m') then
-      errorlabstrm "Hint"
+      user_err ~hdr:"Hint"
 	(pr_global ref ++ str" has " ++ int n ++ 
 	   str" arguments while the mode declares " ++ int (Array.length m'))
     else m'
@@ -812,6 +944,8 @@ let make_trivial env sigma poly ?(name=PathAny) r =
 	      poly = poly;
               pat = Some (Patternops.pattern_of_constr env ce.evd (clenv_type ce));
 	      name = name;
+              db = None;
+              secvars = secvars_of_constr env c;
               code= with_uid (Res_pf_THEN_trivial_fail(c,t,ctx)) })
 
 
@@ -825,7 +959,7 @@ let make_trivial env sigma poly ?(name=PathAny) r =
 
 let get_db dbname =
   try searchtable_map dbname
-  with Not_found -> Hint_db.empty empty_transparent_state false
+  with Not_found -> Hint_db.empty ~name:dbname empty_transparent_state false
 
 let add_hint dbname hintlist =
   let check (_, h) =
@@ -864,7 +998,7 @@ type hint_action =
   | AddHints of hint_entry list
   | RemoveHints of global_reference list
   | AddCut of hints_path
-  | AddMode of global_reference * bool array
+  | AddMode of global_reference * hint_mode array
 
 let add_cut dbname path =
   let db = get_db dbname in
@@ -885,7 +1019,7 @@ type hint_obj = {
 let load_autohint _ (kn, h) =
   let name = h.hint_name in
   match h.hint_action with
-  | CreateDB (b, st) -> searchtable_add (name, Hint_db.empty st b)
+  | CreateDB (b, st) -> searchtable_add (name, Hint_db.empty ~name st b)
   | AddTransparency (grs, b) -> add_transparency name grs b
   | AddHints hints -> add_hint name hints
   | RemoveHints grs -> remove_hint name grs
@@ -1041,16 +1175,17 @@ let add_transparency l b local dbnames =
       Lib.add_anonymous_leaf (inAutoHint hint))
     dbnames
 
-let add_extern pri pat tacast local dbname =
-  let pat = match pat with
+let add_extern info tacast local dbname =
+  let pat = match info.hint_pattern with
   | None -> None
   | Some (_, pat) -> Some pat
   in
-  let hint = make_hint ~local dbname (AddHints [make_extern pri pat tacast]) in
+  let hint = make_hint ~local dbname
+		       (AddHints [make_extern (Option.get info.hint_priority) pat tacast]) in
   Lib.add_anonymous_leaf (inAutoHint hint)
 
-let add_externs pri pat tacast local dbnames =
-  List.iter (add_extern pri pat tacast local) dbnames
+let add_externs info tacast local dbnames =
+  List.iter (add_extern info tacast local) dbnames
 
 let add_trivials env sigma l local dbnames =
   List.iter
@@ -1060,19 +1195,18 @@ let add_trivials env sigma l local dbnames =
       Lib.add_anonymous_leaf (inAutoHint hint))
     dbnames
 
-let (forward_intern_tac, extern_intern_tac) = Hook.make ()
-
 type hnf = bool
 
+type hint_info = (patvar list * constr_pattern) hint_info_gen
+
 type hints_entry =
-  | HintsResolveEntry of (int option * polymorphic * hnf * hints_path_atom * hint_term) list
+  | HintsResolveEntry of (hint_info * polymorphic * hnf * hints_path_atom * hint_term) list
   | HintsImmediateEntry of (hints_path_atom * polymorphic * hint_term) list
   | HintsCutEntry of hints_path
   | HintsUnfoldEntry of evaluable_global_reference list
   | HintsTransparencyEntry of evaluable_global_reference list * bool
-  | HintsModeEntry of global_reference * bool list
-  | HintsExternEntry of
-      int * (patvar list * constr_pattern) option * glob_tactic_expr
+  | HintsModeEntry of global_reference * hint_mode list
+  | HintsExternEntry of hint_info * Genarg.glob_generic_argument
 
 let default_prepare_hint_ident = Id.of_string "H"
 
@@ -1080,10 +1214,12 @@ exception Found of constr * types
 
 let prepare_hint check (poly,local) env init (sigma,c) =
   let sigma = Typeclasses.resolve_typeclasses ~fail:false env sigma in
-  (* We re-abstract over uninstantiated evars.
+  (* We re-abstract over uninstantiated evars and universes.
      It is actually a bit stupid to generalize over evars since the first
      thing make_resolves will do is to re-instantiate the products *)
-  let c = drop_extra_implicit_args (Evarutil.nf_evar sigma c) in
+  let sigma, subst = Evd.nf_univ_variables sigma in
+  let c = Vars.subst_univs_constr subst (Evarutil.nf_evar sigma c) in
+  let c = drop_extra_implicit_args c in
   let vars = ref (collect_vars c) in
   let subst = ref [] in
   let rec find_next_evar c = match kind_of_term c with
@@ -1134,11 +1270,12 @@ let interp_hints poly =
 	(PathHints [gr], poly, IsGlobRef gr)
     | HintsConstr c -> (PathAny, poly, f poly c)
   in
-  let fres (pri, b, r) =
+  let fp = Constrintern.intern_constr_pattern (Global.env()) in
+  let fres (info, b, r) =
     let path, poly, gr = fi r in
-      (pri, poly, b, path, gr)
+    let info = { info with hint_pattern = Option.map fp info.hint_pattern } in
+      (info, poly, b, path, gr)
   in
-  let fp = Constrintern.intern_constr_pattern (Global.env()) in
   match h with
   | HintsResolve lhints -> HintsResolveEntry (List.map fres lhints)
   | HintsImmediate lhints -> HintsImmediateEntry (List.map fi lhints)
@@ -1154,14 +1291,16 @@ let interp_hints poly =
           List.init (nconstructors ind) 
 	    (fun i -> let c = (ind,i+1) in
 		      let gr = ConstructRef c in
-			None, mib.Declarations.mind_polymorphic, true, 
+			empty_hint_info, mib.Declarations.mind_polymorphic, true,
 			PathHints [gr], IsGlobRef gr)
       in HintsResolveEntry (List.flatten (List.map constr_hints_of_ind lqid))
   | HintsExtern (pri, patcom, tacexp) ->
       let pat =	Option.map fp patcom in
       let l = match pat with None -> [] | Some (l, _) -> l in
-      let tacexp = Hook.get forward_intern_tac l tacexp in
-      HintsExternEntry (pri, pat, tacexp)
+      let ltacvars = List.fold_left (fun accu x -> Id.Set.add x accu) Id.Set.empty l in
+      let env = Genintern.({ genv = env; ltacvars }) in
+      let _, tacexp = Genintern.generic_intern env tacexp in
+      HintsExternEntry ({ hint_priority = Some pri; hint_pattern = pat }, tacexp)
 
 let add_hints local dbnames0 h =
   if String.List.mem "nocore" dbnames0 then
@@ -1177,8 +1316,8 @@ let add_hints local dbnames0 h =
   | HintsUnfoldEntry lhints -> add_unfolds lhints local dbnames
   | HintsTransparencyEntry (lhints, b) ->
       add_transparency lhints b local dbnames
-  | HintsExternEntry (pri, pat, tacexp) ->
-      add_externs pri pat tacexp local dbnames
+  | HintsExternEntry (info, tacexp) ->
+      add_externs info tacexp local dbnames
 
 let expand_constructor_hints env sigma lems =
   List.map_append (fun (evd,lem) ->
@@ -1202,7 +1341,7 @@ let add_hint_lemmas env sigma eapply lems hint_db =
   let lems = expand_constructor_hints env sigma lems in
   let hintlist' =
     List.map_append (fun (poly, lem) ->
-		     make_resolves env sigma (eapply,true,false) None poly lem) lems in
+		     make_resolves env sigma (eapply,true,false) empty_hint_info poly lem) lems in
   Hint_db.add_list env sigma hintlist' hint_db
 
 let make_local_hint_db env sigma ts eapply lems =
@@ -1240,23 +1379,25 @@ let make_db_list dbnames =
 let pr_hint_elt (c, _, _) = pr_constr c
 
 let pr_hint h = match h.obj with
-  | Res_pf (c, _) -> (str"apply " ++ pr_hint_elt c)
-  | ERes_pf (c, _) -> (str"eapply " ++ pr_hint_elt c)
+  | Res_pf (c, _) -> (str"simple apply " ++ pr_hint_elt c)
+  | ERes_pf (c, _) -> (str"simple eapply " ++ pr_hint_elt c)
   | Give_exact (c, _) -> (str"exact " ++ pr_hint_elt c)
   | Res_pf_THEN_trivial_fail (c, _) ->
-      (str"apply " ++ pr_hint_elt c ++ str" ; trivial")
+      (str"simple apply " ++ pr_hint_elt c ++ str" ; trivial")
   | Unfold_nth c -> (str"unfold " ++  pr_evaluable_reference c)
   | Extern tac ->
       let env =
         try
           let (_, env) = Pfedit.get_current_goal_context () in
           env
-        with e when Errors.noncritical e -> Global.env ()
+        with e when CErrors.noncritical e -> Global.env ()
       in
-      (str "(*external*) " ++ Pptactic.pr_glb_generic env tac)
+      (str "(*external*) " ++ Pputils.pr_glb_generic env tac)
 
 let pr_id_hint (id, v) =
-  (pr_hint v.code ++ str"(level " ++ int v.pri ++ str", id " ++ int id ++ str ")" ++ spc ())
+  let pr_pat p = str", pattern " ++ pr_lconstr_pattern p in
+  (pr_hint v.code ++ str"(level " ++ int v.pri ++ pr_opt_no_spc pr_pat v.pat
+   ++ str", id " ++ int id ++ str ")" ++ spc ())
 
 let pr_hint_list hintlist =
   (str "  " ++ hov 0 (prlist pr_id_hint hintlist) ++ fnl ())
@@ -1270,7 +1411,7 @@ let pr_hints_db (name,db,hintlist) =
 let pr_hint_list_for_head c =
   let dbs = current_db () in
   let validate (name, db) =
-    let hints = List.map (fun v -> 0, v) (Hint_db.map_all c db) in
+    let hints = List.map (fun v -> 0, v) (Hint_db.map_all Id.Pred.full c db) in
     (name, db, hints)
   in
   let valid_dbs = List.map validate dbs in
@@ -1292,9 +1433,9 @@ let pr_hint_term cl =
       let fn = try
 	  let hdc = decompose_app_bound cl in
 	    if occur_existential cl then
-	      Hint_db.map_existential hdc cl
-	    else Hint_db.map_auto hdc cl
-	with Bound -> Hint_db.map_none
+	      Hint_db.map_existential ~secvars:Id.Pred.full hdc cl
+	    else Hint_db.map_auto ~secvars:Id.Pred.full hdc cl
+	with Bound -> Hint_db.map_none ~secvars:Id.Pred.full
       in
       let fn db = List.map (fun x -> 0, x) (fn db) in
       List.map (fun (name, db) -> (name, db, fn db)) dbs
@@ -1312,13 +1453,18 @@ let pr_applicable_hint () =
   let pts = get_pftreestate () in
   let glss = Proof.V82.subgoals pts in
   match glss.Evd.it with
-  | [] -> Errors.error "No focused goal."
+  | [] -> CErrors.error "No focused goal."
   | g::_ ->
     pr_hint_term (Goal.V82.concl glss.Evd.sigma g)
 
+let pp_hint_mode = function
+  | ModeInput -> str"+"
+  | ModeNoHeadEvar -> str"!"
+  | ModeOutput -> str"-"
+
 (* displays the whole hint database db *)
 let pr_hint_db db =
-  let pr_mode = prvect_with_sep spc (fun x -> if x then str"+" else str"-") in
+  let pr_mode = prvect_with_sep spc pp_hint_mode in
   let pr_modes l = 
     if List.is_empty l then mt ()
     else str" (modes " ++ prlist_with_sep pr_comma pr_mode l ++ str")"
@@ -1366,10 +1512,15 @@ let print_mp mp =
 
 let is_imported h = try KNmap.find h.uid !statustable with Not_found -> true
 
+let warn_non_imported_hint =
+  CWarnings.create ~name:"non-imported-hint" ~category:"automation"
+         (fun (hint,mp) ->
+          strbrk "Hint used but not imported: " ++ hint ++ print_mp mp)
+
 let warn h x =
   let hint = pr_hint h in
   let (mp, _, _) = KerName.repr h.uid in
-  let () = Feedback.msg_warning (str "Hint used but not imported: " ++ hint ++ print_mp mp) in
+  warn_non_imported_hint (hint,mp);
   Proofview.tclUNIT x
 
 let run_hint tac k = match !warn_hint with
@@ -1379,6 +1530,6 @@ let run_hint tac k = match !warn_hint with
   else Proofview.tclBIND (k tac.obj) (fun x -> warn tac x)
 | `STRICT ->
   if is_imported tac then k tac.obj
-  else Proofview.tclZERO (UserError ("", (str "Tactic failure.")))
+  else Proofview.tclZERO (UserError (None, (str "Tactic failure.")))
 
 let repr_hint h = h.obj
diff --git a/tactics/hints.mli b/tactics/hints.mli
index df9d79212..05d41adfe 100644
--- a/tactics/hints.mli
+++ b/tactics/hints.mli
@@ -15,6 +15,7 @@ open Globnames
 open Decl_kinds
 open Evd
 open Misctypes
+open Tactypes
 open Clenv
 open Pattern
 open Vernacexpr
@@ -25,6 +26,12 @@ exception Bound
 
 val decompose_app_bound : constr -> global_reference * constr array
 
+type debug = Debug | Info | Off
+
+val secvars_of_hyps : Context.Named.t -> Id.Pred.t
+
+val empty_hint_info : 'a hint_info_gen
+
 (** Pre-created hint databases *)
 
 type 'a hint_ast =
@@ -38,16 +45,22 @@ type 'a hint_ast =
 type hint
 type raw_hint = constr * types * Univ.universe_context_set
 
-type hints_path_atom = 
-  | PathHints of global_reference list
+type 'a hints_path_atom_gen =
+  | PathHints of 'a list
+  (* For forward hints, their names is the list of projections *)
   | PathAny
 
+type hints_path_atom = global_reference hints_path_atom_gen
+type hint_db_name = string
+
 type 'a with_metadata = private {
   pri   : int;            (** A number between 0 and 4, 4 = lower priority *)
   poly  : polymorphic;    (** Is the hint polymorpic and hence should be refreshed at each application *)
   pat   : constr_pattern option; (** A pattern for the concl of the Goal *)
   name  : hints_path_atom; (** A potential name to refer to the hint *) 
-  code  : 'a; (** the tactic to apply when the concl matches pat *)
+  db    : hint_db_name option;
+  secvars : Id.Pred.t; (** The section variables this hint depends on, as a predicate *)
+  code    : 'a; (** the tactic to apply when the concl matches pat *)
 }
 
 type full_hint = hint with_metadata
@@ -58,47 +71,63 @@ type search_entry
 
 type hint_entry
 
-type hints_path =
-  | PathAtom of hints_path_atom
-  | PathStar of hints_path
-  | PathSeq of hints_path * hints_path
-  | PathOr of hints_path * hints_path
+type 'a hints_path_gen =
+  | PathAtom of 'a hints_path_atom_gen
+  | PathStar of 'a hints_path_gen
+  | PathSeq of 'a hints_path_gen * 'a hints_path_gen
+  | PathOr of 'a hints_path_gen * 'a hints_path_gen
   | PathEmpty
   | PathEpsilon
 
+type pre_hints_path = Libnames.reference hints_path_gen
+type hints_path = global_reference hints_path_gen
+    
 val normalize_path : hints_path -> hints_path
 val path_matches : hints_path -> hints_path_atom list -> bool
 val path_derivate : hints_path -> hints_path_atom -> hints_path
-val pp_hints_path_atom : hints_path_atom -> Pp.std_ppcmds
+val pp_hints_path_gen : ('a -> Pp.std_ppcmds) -> 'a hints_path_gen -> Pp.std_ppcmds
+val pp_hints_path_atom : ('a -> Pp.std_ppcmds) -> 'a hints_path_atom_gen -> Pp.std_ppcmds
 val pp_hints_path : hints_path -> Pp.std_ppcmds
+val pp_hint_mode : hint_mode -> Pp.std_ppcmds
+val glob_hints_path_atom :
+  Libnames.reference hints_path_atom_gen -> Globnames.global_reference hints_path_atom_gen
+val glob_hints_path :
+  Libnames.reference hints_path_gen -> Globnames.global_reference hints_path_gen
 
 module Hint_db :
   sig
     type t
-    val empty : transparent_state -> bool -> t
+    val empty : ?name:hint_db_name -> transparent_state -> bool -> t
     val find : global_reference -> t -> search_entry
-    val map_none : t -> full_hint list
+
+    (** All hints which have no pattern.
+     * [secvars] represent the set of section variables that
+     * can be used in the hint. *)
+    val map_none : secvars:Id.Pred.t -> t -> full_hint list
 
     (** All hints associated to the reference *)
-    val map_all : global_reference -> t -> full_hint list
+    val map_all : secvars:Id.Pred.t -> global_reference -> t -> full_hint list
 
     (** All hints associated to the reference, respecting modes if evars appear in the 
 	arguments, _not_ using the discrimination net. *)
-    val map_existential : (global_reference * constr array) -> constr -> t -> full_hint list
+    val map_existential : secvars:Id.Pred.t ->
+      (global_reference * constr array) -> constr -> t -> full_hint list
 
     (** All hints associated to the reference, respecting modes if evars appear in the 
 	arguments and using the discrimination net. *)
-    val map_eauto : (global_reference * constr array) -> constr -> t -> full_hint list
+    val map_eauto : secvars:Id.Pred.t -> (global_reference * constr array) -> constr -> t -> full_hint list
 
     (** All hints associated to the reference, respecting modes if evars appear in the 
 	arguments. *)
-    val map_auto : (global_reference * constr array) -> constr -> t -> full_hint list
+    val map_auto : secvars:Id.Pred.t ->
+       (global_reference * constr array) -> constr -> t -> full_hint list
 
     val add_one : env -> evar_map -> hint_entry -> t -> t
     val add_list : env -> evar_map -> hint_entry list -> t -> t
     val remove_one : global_reference -> t -> t
     val remove_list : global_reference list -> t -> t
-    val iter : (global_reference option -> bool array list -> full_hint list -> unit) -> t -> unit
+    val iter : (global_reference option ->
+                hint_mode array list -> full_hint list -> unit) -> t -> unit
 
     val use_dn : t -> bool
     val transparent_state : t -> transparent_state
@@ -110,26 +139,25 @@ module Hint_db :
     val unfolds : t -> Id.Set.t * Cset.t
   end
 
-type hint_db_name = string
-
 type hint_db = Hint_db.t
 
 type hnf = bool
 
+type hint_info = (patvar list * constr_pattern) hint_info_gen
+
 type hint_term =
   | IsGlobRef of global_reference
   | IsConstr of constr * Univ.universe_context_set
 
 type hints_entry =
-  | HintsResolveEntry of (int option * polymorphic * hnf * hints_path_atom * 
-			  hint_term) list
+  | HintsResolveEntry of
+    (hint_info * polymorphic * hnf * hints_path_atom * hint_term) list
   | HintsImmediateEntry of (hints_path_atom * polymorphic * hint_term) list
   | HintsCutEntry of hints_path
   | HintsUnfoldEntry of evaluable_global_reference list
   | HintsTransparencyEntry of evaluable_global_reference list * bool
-  | HintsModeEntry of global_reference * bool list      
-  | HintsExternEntry of
-      int * (patvar list * constr_pattern) option * Tacexpr.glob_tactic_expr
+  | HintsModeEntry of global_reference * hint_mode list
+  | HintsExternEntry of hint_info * Genarg.glob_generic_argument
 
 val searchtable_map : hint_db_name -> hint_db
 
@@ -156,22 +184,34 @@ val prepare_hint : bool (* Check no remaining evars *) ->
   (bool * bool) (* polymorphic or monomorphic, local or global *) ->
   env -> evar_map -> open_constr -> hint_term
 
-(** [make_exact_entry pri (c, ctyp)].
+(** [make_exact_entry info (c, ctyp, ctx)].
    [c] is the term given as an exact proof to solve the goal;
-   [ctyp] is the type of [c]. *)
-
-val make_exact_entry : env -> evar_map -> int option -> polymorphic -> ?name:hints_path_atom -> 
+   [ctyp] is the type of [c].
+   [ctx] is its (refreshable) universe context. 
+   In info:
+   [hint_priority] is the hint's desired priority, it is 0 if unspecified
+   [hint_pattern] is the hint's desired pattern, it is inferred if not specified
+*)
+
+val make_exact_entry : env -> evar_map -> hint_info -> polymorphic -> ?name:hints_path_atom ->
   (constr * types * Univ.universe_context_set) -> hint_entry
 
-(** [make_apply_entry (eapply,hnf,verbose) pri (c,cty)].
+(** [make_apply_entry (eapply,hnf,verbose) info (c,cty,ctx))].
    [eapply] is true if this hint will be used only with EApply;
    [hnf] should be true if we should expand the head of cty before searching for
    products;
    [c] is the term given as an exact proof to solve the goal;
-   [cty] is the type of [c]. *)
+   [cty] is the type of [c].
+   [ctx] is its (refreshable) universe context. 
+   In info:
+   [hint_priority] is the hint's desired priority, it is computed as the number of products in [cty]
+   if unspecified
+   [hint_pattern] is the hint's desired pattern, it is inferred from the conclusion of [cty]
+   if not specified
+*)
 
 val make_apply_entry :
-  env -> evar_map -> bool * bool * bool -> int option -> polymorphic -> ?name:hints_path_atom -> 
+  env -> evar_map -> bool * bool * bool -> hint_info -> polymorphic -> ?name:hints_path_atom ->
   (constr * types * Univ.universe_context_set) -> hint_entry
 
 (** A constr which is Hint'ed will be:
@@ -182,7 +222,7 @@ val make_apply_entry :
          has missing arguments. *)
 
 val make_resolves :
-  env -> evar_map -> bool * bool * bool -> int option -> polymorphic -> ?name:hints_path_atom -> 
+  env -> evar_map -> bool * bool * bool -> hint_info -> polymorphic -> ?name:hints_path_atom ->
   hint_term -> hint_entry list
 
 (** [make_resolve_hyp hname htyp].
@@ -196,7 +236,7 @@ val make_resolve_hyp :
 (** [make_extern pri pattern tactic_expr] *)
 
 val make_extern :
-  int -> constr_pattern option -> Tacexpr.glob_tactic_expr
+  int -> constr_pattern option -> Genarg.glob_generic_argument
       -> hint_entry
 
 val run_hint : hint ->
@@ -206,14 +246,11 @@ val run_hint : hint ->
     written code. *)
 val repr_hint : hint -> (raw_hint * clausenv) hint_ast
 
-val extern_intern_tac :
-  (patvar list -> Tacexpr.raw_tactic_expr -> Tacexpr.glob_tactic_expr) Hook.t
-
 (** Create a Hint database from the pairs (name, constr).
    Useful to take the current goal hypotheses as hints;
    Boolean tells if lemmas with evars are allowed *)
 
-val make_local_hint_db : env -> evar_map -> ?ts:transparent_state -> bool -> Tacexpr.delayed_open_constr list -> hint_db
+val make_local_hint_db : env -> evar_map -> ?ts:transparent_state -> bool -> delayed_open_constr list -> hint_db
 
 val make_db_list : hint_db_name list -> hint_db list
 
diff --git a/tactics/hipattern.ml4 b/tactics/hipattern.ml
index bcec90f80..27af7200b 100644
--- a/tactics/hipattern.ml4
+++ b/tactics/hipattern.ml
@@ -6,10 +6,8 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i camlp4deps: "grammar/grammar.cma grammar/q_constr.cmo" i*)
-
 open Pp
-open Errors
+open CErrors
 open Util
 open Names
 open Term
@@ -21,6 +19,8 @@ open Declarations
 open Tacmach.New
 open Context.Rel.Declaration
 
+module RelDecl = Context.Rel.Declaration
+
 (* 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.
@@ -102,7 +102,7 @@ let match_with_one_constructor style onlybinary allow_rec t =
 	      (decompose_prod_n_assum mib.mind_nparams mip.mind_nf_lc.(0)))) in
 	  if
 	    List.for_all
-	      (fun decl -> let c = get_type decl in
+	      (fun decl -> let c = RelDecl.get_type decl in
 	                   is_local_assum decl &&
 			   isRel c &&
                            Int.equal (destRel c) mib.mind_nparams) ctx
@@ -111,7 +111,7 @@ let match_with_one_constructor style onlybinary allow_rec t =
 	  else None
 	else
 	  let ctyp = prod_applist mip.mind_nf_lc.(0) args in
-	  let cargs = List.map get_type (prod_assum ctyp) in
+	  let cargs = List.map RelDecl.get_type (prod_assum ctyp) in
 	  if not (is_lax_conjunction style) || has_nodep_prod ctyp then
 	    (* Record or non strict conjunction *)
 	    Some (hdapp,List.rev cargs)
@@ -243,9 +243,36 @@ type equation_kind =
 
 exception NoEquationFound
 
-let coq_refl_leibniz1_pattern = PATTERN [ forall x:_, _ x x ]
-let coq_refl_leibniz2_pattern = PATTERN [ forall A:_, forall x:A, _ A x x ]
-let coq_refl_jm_pattern       = PATTERN [ forall A:_, forall x:A, _ A x A x ]
+open Glob_term
+open Decl_kinds
+open Evar_kinds
+
+let mkPattern c = snd (Patternops.pattern_of_glob_constr c)
+let mkGApp f args = GApp (Loc.ghost, f, args)
+let mkGHole =
+  GHole (Loc.ghost, QuestionMark (Define false), Misctypes.IntroAnonymous, None)
+let mkGProd id c1 c2 =
+  GProd (Loc.ghost, Name (Id.of_string id), Explicit, c1, c2)
+let mkGArrow c1 c2 =
+  GProd (Loc.ghost, Anonymous, Explicit, c1, c2)
+let mkGVar id = GVar (Loc.ghost, Id.of_string id)
+let mkGPatVar id = GPatVar(Loc.ghost, (false, Id.of_string id))
+let mkGRef r = GRef (Loc.ghost, Lazy.force r, None)
+let mkGAppRef r args = mkGApp (mkGRef r) args
+
+(** forall x : _, _ x x *)
+let coq_refl_leibniz1_pattern =
+  mkPattern (mkGProd "x" mkGHole (mkGApp mkGHole [mkGVar "x"; mkGVar "x";]))
+
+(** forall A:_, forall x:A, _ A x x *)
+let coq_refl_leibniz2_pattern =
+  mkPattern (mkGProd "A" mkGHole (mkGProd "x" (mkGVar "A")
+    (mkGApp mkGHole [mkGVar "A"; mkGVar "x"; mkGVar "x";])))
+
+(** forall A:_, forall x:A, _ A x A x *)
+let coq_refl_jm_pattern       =
+  mkPattern (mkGProd "A" mkGHole (mkGProd "x" (mkGVar "A")
+    (mkGApp mkGHole [mkGVar "A"; mkGVar "x"; mkGVar "A"; mkGVar "x";])))
 
 open Globnames
 
@@ -301,7 +328,8 @@ let is_equality_type t = op2bool (match_with_equality_type t)
 
 (* Arrows/Implication/Negation *)
 
-let coq_arrow_pattern = PATTERN [ ?X1 -> ?X2 ]
+(** X1 -> X2 **)
+let coq_arrow_pattern = mkPattern (mkGArrow (mkGPatVar "X1") (mkGPatVar "X2"))
 
 let match_arrow_pattern t =
   let result = matches coq_arrow_pattern t in
@@ -380,33 +408,27 @@ let rec first_match matcher = function
 
 (*** Equality *)
 
-(* 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_identity_pattern = coq_eq_pattern_gen coq_identity_ref
-let coq_jmeq_pattern = lazy PATTERN [ %coq_jmeq_ref ?X1 ?X2 ?X3 ?X4 ]
-
-let match_eq eqn eq_pat =
-  let pat =
-    try Lazy.force eq_pat
-    with e when Errors.noncritical e -> raise PatternMatchingFailure
+let match_eq eqn (ref, hetero) =
+  let ref =
+    try Lazy.force ref
+    with e when CErrors.noncritical e -> raise PatternMatchingFailure
   in
-  match Id.Map.bindings (matches pat eqn) with
-    | [(m1,t);(m2,x);(m3,y)] ->
-	assert (Id.equal m1 meta1 && Id.equal m2 meta2 && Id.equal m3 meta3);
-        PolymorphicLeibnizEq (t,x,y)
-    | [(m1,t);(m2,x);(m3,t');(m4,x')] ->
-        assert (Id.equal m1 meta1 && Id.equal m2 meta2 && Id.equal m3 meta3 && Id.equal m4 meta4);
-	HeterogenousEq (t,x,t',x')
-    | _ -> anomaly ~label:"match_eq" (Pp.str "an eq pattern should match 3 or 4 terms")
+  match kind_of_term eqn with
+  | App (c, [|t; x; y|]) ->
+    if not hetero && is_global ref c then PolymorphicLeibnizEq (t, x, y)
+    else raise PatternMatchingFailure
+  | App (c, [|t; x; t'; x'|]) ->
+    if hetero && is_global ref c then HeterogenousEq (t, x, t', x')
+    else raise PatternMatchingFailure
+  | _ -> raise PatternMatchingFailure
 
 let no_check () = true
 let check_jmeq_loaded () = Library.library_is_loaded Coqlib.jmeq_module
 
 let equalities =
-  [coq_eq_pattern, no_check, build_coq_eq_data;
-   coq_jmeq_pattern, check_jmeq_loaded, build_coq_jmeq_data;
-   coq_identity_pattern, no_check, build_coq_identity_data]
+  [(coq_eq_ref, false), no_check, build_coq_eq_data;
+   (coq_jmeq_ref, true), check_jmeq_loaded, build_coq_jmeq_data;
+   (coq_identity_ref, false), no_check, build_coq_identity_data]
 
 let find_eq_data eqn = (* fails with PatternMatchingFailure *)
   let d,k = first_match (match_eq eqn) equalities in
@@ -430,18 +452,21 @@ let find_this_eq_data_decompose gl eqn =
     try (*first_match (match_eq eqn) inversible_equalities*)
       find_eq_data eqn
     with PatternMatchingFailure ->
-      errorlabstrm "" (str "No primitive equality found.") in
+      user_err  (str "No primitive equality found.") in
   let eq_args =
     try extract_eq_args gl eq_args
     with PatternMatchingFailure ->
       error "Don't know what to do with JMeq on arguments not of same type." in
   (lbeq,u,eq_args)
 
-let match_eq_nf gls eqn eq_pat =
-  match Id.Map.bindings (pf_matches gls (Lazy.force eq_pat) eqn) with
+let match_eq_nf gls eqn (ref, hetero) =
+  let n = if hetero then 4 else 3 in
+  let args = List.init n (fun i -> mkGPatVar ("X" ^ string_of_int (i + 1))) in
+  let pat = mkPattern (mkGAppRef ref args) in
+  match Id.Map.bindings (pf_matches gls pat eqn) with
     | [(m1,t);(m2,x);(m3,y)] ->
         assert (Id.equal m1 meta1 && Id.equal m2 meta2 && Id.equal m3 meta3);
-	(t,pf_whd_betadeltaiota gls x,pf_whd_betadeltaiota gls y)
+	(t,pf_whd_all gls x,pf_whd_all gls y)
     | _ -> anomaly ~label:"match_eq" (Pp.str "an eq pattern should match 3 terms")
 
 let dest_nf_eq gls eqn =
@@ -464,7 +489,8 @@ let find_sigma_data_decompose ex = (* fails with PatternMatchingFailure *)
   match_sigma ex
 
 (* Pattern "(sig ?1 ?2)" *)
-let coq_sig_pattern = lazy PATTERN [ %coq_sig_ref ?X1 ?X2 ]
+let coq_sig_pattern =
+  lazy (mkPattern (mkGAppRef coq_sig_ref [mkGPatVar "X1"; mkGPatVar "X2"]))
 
 let match_sigma t =
   match Id.Map.bindings (matches (Lazy.force coq_sig_pattern) t) with
@@ -480,17 +506,25 @@ let is_matching_sigma t = is_matching (Lazy.force coq_sig_pattern) t
 (* Pattern "{<?1>x=y}+{~(<?1>x=y)}" *)
 (* i.e. "(sumbool (eq ?1 x y) ~(eq ?1 x y))" *)
 
-let coq_eqdec_inf_pattern =
- lazy PATTERN [ { ?X2 = ?X3 :> ?X1 } + { ~ ?X2 = ?X3 :> ?X1 } ]
+let coq_eqdec ~sum ~rev =
+  lazy (
+    let eqn = mkGAppRef coq_eq_ref (List.map mkGPatVar ["X1"; "X2"; "X3"]) in
+    let args = [eqn; mkGAppRef coq_not_ref [eqn]] in
+    let args = if rev then List.rev args else args in
+    mkPattern (mkGAppRef sum args)
+  )
+
+(** { ?X2 = ?X3 :> ?X1 } + { ~ ?X2 = ?X3 :> ?X1 } *)
+let coq_eqdec_inf_pattern = coq_eqdec ~sum:coq_sumbool_ref ~rev:false
 
-let coq_eqdec_inf_rev_pattern =
- lazy PATTERN [ { ~ ?X2 = ?X3 :> ?X1 } + { ?X2 = ?X3 :> ?X1 } ]
+(** { ~ ?X2 = ?X3 :> ?X1 } + { ?X2 = ?X3 :> ?X1 } *)
+let coq_eqdec_inf_rev_pattern = coq_eqdec ~sum:coq_sumbool_ref ~rev:true
 
-let coq_eqdec_pattern =
- lazy PATTERN [ %coq_or_ref (?X2 = ?X3 :> ?X1) (~ ?X2 = ?X3 :> ?X1) ]
+(** %coq_or_ref (?X2 = ?X3 :> ?X1) (~ ?X2 = ?X3 :> ?X1) *)
+let coq_eqdec_pattern = coq_eqdec ~sum:coq_or_ref ~rev:false
 
-let coq_eqdec_rev_pattern =
- lazy PATTERN [ %coq_or_ref (~ ?X2 = ?X3 :> ?X1) (?X2 = ?X3 :> ?X1) ]
+(** %coq_or_ref (~ ?X2 = ?X3 :> ?X1) (?X2 = ?X3 :> ?X1) *)
+let coq_eqdec_rev_pattern = coq_eqdec ~sum:coq_or_ref ~rev:true
 
 let op_or = coq_or_ref
 let op_sum = coq_sumbool_ref
@@ -510,8 +544,8 @@ let match_eqdec t =
   | _ -> anomaly (Pp.str "Unexpected pattern")
 
 (* Patterns "~ ?" and "? -> False" *)
-let coq_not_pattern = lazy PATTERN [ ~ _ ]
-let coq_imp_False_pattern = lazy PATTERN [ _ -> %coq_False_ref ]
+let coq_not_pattern = lazy (mkPattern (mkGAppRef coq_not_ref [mkGHole]))
+let coq_imp_False_pattern = lazy (mkPattern (mkGArrow mkGHole (mkGRef 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
diff --git a/tactics/inv.ml b/tactics/inv.ml
index 3707ef90b..e7d8249e4 100644
--- a/tactics/inv.ml
+++ b/tactics/inv.ml
@@ -7,7 +7,7 @@
 (************************************************************************)
 
 open Pp
-open Errors
+open CErrors
 open Util
 open Names
 open Nameops
@@ -25,10 +25,10 @@ open Tactics
 open Elim
 open Equality
 open Misctypes
-open Tacexpr
 open Sigma.Notations
 open Proofview.Notations
-open Context.Named.Declaration
+
+module NamedDecl = Context.Named.Declaration
 
 let var_occurs_in_pf gl id =
   let env = Proofview.Goal.env gl in
@@ -76,7 +76,7 @@ let make_inv_predicate env evd indf realargs id status concl =
 	    (hyps_arity,concl)
       | Dep dflt_concl ->
 	  if not (occur_var env id concl) then
-	    errorlabstrm "make_inv_predicate"
+	    user_err ~hdr:"make_inv_predicate"
               (str "Current goal does not depend on " ++ pr_id id ++ str".");
           (* We abstract the conclusion of goal with respect to
              realargs and c to * be concl in order to rewrite and have
@@ -182,7 +182,7 @@ let dependent_hyps env id idlist gl =
     | [] -> []
     | d::l ->
 	(* Update the type of id1: it may have been subject to rewriting *)
-	let d = pf_get_hyp (get_id d) gl in
+	let d = pf_get_hyp (NamedDecl.get_id d) gl in
 	if occur_var_in_decl env id d
         then d :: dep_rec l
         else dep_rec l
@@ -192,7 +192,7 @@ let dependent_hyps env id idlist gl =
 let split_dep_and_nodep hyps gl =
   List.fold_right
     (fun d (l1,l2) ->
-       if var_occurs_in_pf gl (get_id d) then (d::l1,l2) else (l1,d::l2))
+       if var_occurs_in_pf gl (NamedDecl.get_id d) then (d::l1,l2) else (l1,d::l2))
     hyps ([],[])
 
 (* Computation of dids is late; must have been done in rewrite_equations*)
@@ -383,7 +383,7 @@ let rewrite_equations as_mode othin neqns names ba =
   Proofview.Goal.nf_enter { enter = begin fun gl ->
   let (depids,nodepids) = split_dep_and_nodep ba.Tacticals.assums gl in
   let first_eq = ref MoveLast in
-  let avoid = if as_mode then List.map get_id nodepids else [] in
+  let avoid = if as_mode then List.map NamedDecl.get_id nodepids else [] in
   match othin with
     | Some thin ->
         tclTHENLIST
@@ -399,10 +399,10 @@ let rewrite_equations as_mode othin neqns names ba =
 		   tclTRY (projectAndApply as_mode thin avoid id first_eq names depids)))))
 	       names;
 	     tclMAP (fun d -> tclIDTAC >>= fun () -> (* delay for [first_eq]. *)
-               let idopt = if as_mode then Some (get_id d) else None in
+               let idopt = if as_mode then Some (NamedDecl.get_id d) else None in
 	       intro_move idopt (if thin then MoveLast else !first_eq))
 	       nodepids;
-	     (tclMAP (fun d -> tclTRY (clear [get_id d])) depids)]
+	     (tclMAP (fun d -> tclTRY (clear [NamedDecl.get_id d])) depids)]
     | None ->
         (* simple inversion *)
         if as_mode then
@@ -440,7 +440,7 @@ let raw_inversion inv_kind id status names =
       try pf_apply Tacred.reduce_to_atomic_ind gl (pf_unsafe_type_of gl c)
       with UserError _ ->
         let msg = str "The type of " ++ pr_id id ++ str " is not inductive." in
-        Errors.errorlabstrm "" msg
+        CErrors.user_err  msg
     in
     let IndType (indf,realargs) = find_rectype env sigma t in
     let evdref = ref sigma in
@@ -465,7 +465,7 @@ let raw_inversion inv_kind id status names =
       (tclTHENS
         (assert_before Anonymous cut_concl)
         [case_tac names
-            (introCaseAssumsThen
+            (introCaseAssumsThen false (* ApplyOn not supported by inversion *)
                (rewrite_equations_tac as_mode inv_kind id neqns))
             (Some elim_predicate) ind (c, t);
         onLastHypId (fun id -> tclTHEN (refined id) reflexivity)])
@@ -496,8 +496,6 @@ let inversion inv_kind status names id =
 let inv_gen thin status names =
   try_intros_until (inversion thin status names)
 
-open Tacexpr
-
 let inv k = inv_gen k NoDep
 
 let inv_tac id       = inv FullInversion None (NamedHyp id)
diff --git a/tactics/inv.mli b/tactics/inv.mli
index af1cb996a..df629e7c9 100644
--- a/tactics/inv.mli
+++ b/tactics/inv.mli
@@ -9,7 +9,7 @@
 open Names
 open Term
 open Misctypes
-open Tacexpr
+open Tactypes
 
 type inversion_status = Dep of constr option | NoDep
 
diff --git a/tactics/leminv.ml b/tactics/leminv.ml
index 70782ec64..10fc5076c 100644
--- a/tactics/leminv.ml
+++ b/tactics/leminv.ml
@@ -7,7 +7,7 @@
 (************************************************************************)
 
 open Pp
-open Errors
+open CErrors
 open Util
 open Names
 open Term
@@ -29,6 +29,8 @@ open Decl_kinds
 open Proofview.Notations
 open Context.Named.Declaration
 
+module NamedDecl = Context.Named.Declaration
+
 let no_inductive_inconstr env sigma constr =
   (str "Cannot recognize an inductive predicate in " ++
      pr_lconstr_env env sigma constr ++
@@ -114,7 +116,7 @@ let max_prefix_sign lid sign =
     | id::l -> snd (max_rec (id, sign_prefix id sign) l)
 *)
 let rec add_prods_sign env sigma t =
-  match kind_of_term (whd_betadeltaiota env sigma t) with
+  match kind_of_term (whd_all env sigma t) with
     | Prod (na,c1,b) ->
 	let id = id_of_name_using_hdchar env t na in
 	let b'= subst1 (mkVar id) b in
@@ -156,7 +158,7 @@ let compute_first_inversion_scheme env sigma ind sort dep_option =
       let revargs,ownsign =
 	fold_named_context
 	  (fun env d (revargs,hyps) ->
-             let id = get_id d in
+             let id = NamedDecl.get_id d in
              if Id.List.mem id ivars then
 	       ((mkVar id)::revargs, Context.Named.add d hyps)
 	     else
@@ -167,7 +169,7 @@ let compute_first_inversion_scheme env sigma ind sort dep_option =
       let goal = mkArrow i (applist(mkVar p, List.rev revargs)) in
       (pty,goal)
   in
-  let npty = nf_betadeltaiota env sigma pty in
+  let npty = nf_all env sigma pty in
   let extenv = push_named (LocalAssum (p,npty)) env in
   extenv, goal
 
@@ -183,7 +185,7 @@ let inversion_scheme env sigma t sort dep_option inv_op =
   let ind =
     try find_rectype env sigma i
     with Not_found ->
-      errorlabstrm "inversion_scheme" (no_inductive_inconstr env sigma i)
+      user_err ~hdr:"inversion_scheme" (no_inductive_inconstr env sigma i)
   in
   let (invEnv,invGoal) =
     compute_first_inversion_scheme env sigma ind sort dep_option
@@ -193,7 +195,7 @@ let inversion_scheme env sigma t sort dep_option inv_op =
        (global_vars env invGoal)
        (ids_of_named_context (named_context invEnv)));
   (*
-    errorlabstrm "lemma_inversion"
+    user_err ~hdr:"lemma_inversion"
     (str"Computed inversion goal was not closed in initial signature.");
   *)
   let pf = Proof.start (Evd.from_ctx (evar_universe_context sigma)) [invEnv,invGoal] in
@@ -202,11 +204,11 @@ let inversion_scheme env sigma t sort dep_option inv_op =
       tclTHEN intro (onLastHypId inv_op)) pf)
   in
   let pfterm = List.hd (Proof.partial_proof pf) in
-  let global_named_context = Global.named_context () in
+  let global_named_context = Global.named_context_val () in
   let ownSign = ref begin
     fold_named_context
       (fun env d sign ->
-         if mem_named_context (get_id d) global_named_context then sign
+         if mem_named_context_val (NamedDecl.get_id d) global_named_context then sign
 	 else Context.Named.add d sign)
       invEnv ~init:Context.Named.empty
   end in
@@ -247,8 +249,8 @@ let add_inversion_lemma_exn na com comsort bool tac =
   try
     add_inversion_lemma na env sigma c sort bool tac
   with
-    |   UserError ("Case analysis",s) -> (* Reference to Indrec *)
-	  errorlabstrm "Inv needs Nodep Prop Set" s
+    |   UserError (Some "Case analysis",s) -> (* Reference to Indrec *)
+	  user_err ~hdr:"Inv needs Nodep Prop Set" s
 
 (* ================================= *)
 (* Applying a given inversion lemma  *)
@@ -261,10 +263,10 @@ let lemInv id c gls =
     Proofview.V82.of_tactic (Clenvtac.res_pf clause ~flags:(Unification.elim_flags ()) ~with_evars:false) gls
   with
     | NoSuchBinding ->
-	errorlabstrm ""
+	user_err 
 	  (hov 0 (pr_constr c ++ spc () ++ str "does not refer to an inversion lemma."))
     | UserError (a,b) ->
-	 errorlabstrm "LemInv"
+	 user_err ~hdr:"LemInv"
 	   (str "Cannot refine current goal with the lemma " ++
 	      pr_lconstr_env (Refiner.pf_env gls) (Refiner.project gls) c)
 
diff --git a/tactics/tacticals.ml b/tactics/tacticals.ml
index 7f904a561..c5562b326 100644
--- a/tactics/tacticals.ml
+++ b/tactics/tacticals.ml
@@ -7,7 +7,7 @@
 (************************************************************************)
 
 open Pp
-open Errors
+open CErrors
 open Util
 open Names
 open Term
@@ -15,8 +15,10 @@ open Termops
 open Declarations
 open Tacmach
 open Clenv
+open Tactypes
 open Sigma.Notations
-open Context.Named.Declaration
+
+module NamedDecl = Context.Named.Declaration
 
 (************************************************************************)
 (* Tacticals re-exported from the Refiner module                        *)
@@ -70,7 +72,7 @@ let nthDecl m gl =
   try List.nth (pf_hyps gl) (m-1)
   with Failure _ -> error "No such assumption."
 
-let nthHypId m gl = nthDecl m gl |> get_id
+let nthHypId m gl = nthDecl m gl |> NamedDecl.get_id
 let nthHyp m gl   = mkVar (nthHypId m gl)
 
 let lastDecl gl   = nthDecl 1 gl
@@ -81,7 +83,7 @@ let nLastDecls n gl =
   try List.firstn n (pf_hyps gl)
   with Failure _ -> error "Not enough hypotheses in the goal."
 
-let nLastHypsId n gl = List.map get_id (nLastDecls n gl)
+let nLastHypsId n gl = List.map NamedDecl.get_id (nLastDecls n gl)
 let nLastHyps n gl   = List.map mkVar (nLastHypsId n gl)
 
 let onNthDecl m tac gl  = tac (nthDecl m gl) gl
@@ -99,7 +101,7 @@ let onNLastHypsId n tac = onHyps (nLastHypsId n) tac
 let onNLastHyps n tac   = onHyps (nLastHyps n) tac
 
 let afterHyp id gl =
-  fst (List.split_when (Id.equal id % get_id) (pf_hyps gl))
+  fst (List.split_when (NamedDecl.get_id %> Id.equal id) (pf_hyps gl))
 
 (***************************************)
 (*           Clause Tacticals          *)
@@ -151,7 +153,7 @@ type branch_args = {
   nassums    : int;         (* number of assumptions/letin to be introduced *)
   branchsign : bool list;   (* the signature of the branch.
                                true=assumption, false=let-in *)
-  branchnames : Tacexpr.intro_patterns}
+  branchnames : intro_patterns}
 
 type branch_assumptions = {
   ba        : branch_args;       (* the branch args *)
@@ -172,14 +174,14 @@ let check_or_and_pattern_size check_and loc names branchsigns =
   let n = Array.length branchsigns in
   let msg p1 p2 = strbrk "a conjunctive pattern made of " ++ int p1 ++ (if p1 == p2 then mt () else str " or " ++ int p2) ++ str " patterns" in
   let err1 p1 p2 =
-    user_err_loc (loc,"",str "Expects " ++ msg p1 p2 ++ str ".") in
+    user_err ~loc  (str "Expects " ++ msg p1 p2 ++ str ".") in
   let errn n =
-    user_err_loc (loc,"",str "Expects a disjunctive pattern with " ++ int n
+    user_err ~loc  (str "Expects a disjunctive pattern with " ++ int n
 	++ str " branches.") in
   let err1' p1 p2 =
-    user_err_loc (loc,"",strbrk "Expects a disjunctive pattern with 1 branch or " ++ msg p1 p2 ++ str ".") in
+    user_err ~loc  (strbrk "Expects a disjunctive pattern with 1 branch or " ++ msg p1 p2 ++ str ".") in
   let errforthcoming loc =
-    user_err_loc (loc,"",strbrk "Unexpected non atomic pattern.") in
+    user_err ~loc  (strbrk "Unexpected non atomic pattern.") in
   match names with
   | IntroAndPattern l ->
       if not (Int.equal n 1) then errn n;
@@ -311,7 +313,7 @@ module New = struct
     tclZERO (Refiner.FailError (lvl,lazy msg))
 
   let tclZEROMSG ?loc msg =
-    let err = UserError ("", msg) in
+    let err = UserError (None, msg) in
     let info = match loc with
     | None -> Exninfo.null
     | Some loc -> Loc.add_loc Exninfo.null loc
@@ -322,7 +324,7 @@ module New = struct
     try
       Refiner.catch_failerror e;
       tclUNIT ()
-    with e -> tclZERO e
+    with e when CErrors.noncritical e -> tclZERO e
 
   (* spiwack: I chose to give the Ltac + the same semantics as
      [Proofview.tclOR], however, for consistency with the or-else
@@ -366,6 +368,16 @@ module New = struct
           catch_failerror e <*> t2
         end
     end
+
+  let tclORELSE0L t1 t2 =
+    tclINDEPENDENTL begin
+      tclORELSE
+        t1
+        begin fun e ->
+          catch_failerror e <*> t2
+        end
+    end
+
   let tclORELSE t1 t2 =
     tclORELSE0 (tclPROGRESS t1) t2
 
@@ -417,6 +429,9 @@ module New = struct
 
   let tclTRY t =
     tclORELSE0 t (tclUNIT ())
+  
+  let tclTRYb t =
+    tclORELSE0L (t <*> tclUNIT true) (tclUNIT false)
 
   let tclIFTHENELSE t1 t2 t3 =
     tclINDEPENDENT begin
@@ -476,6 +491,13 @@ module New = struct
   let tclPROGRESS t =
     Proofview.tclINDEPENDENT (Proofview.tclPROGRESS t)
 
+  (* Select a subset of the goals *)
+  let tclSELECT = function
+    | Vernacexpr.SelectNth i -> Proofview.tclFOCUS i i
+    | Vernacexpr.SelectList l -> Proofview.tclFOCUSLIST l
+    | Vernacexpr.SelectId id -> Proofview.tclFOCUSID id
+    | Vernacexpr.SelectAll -> fun tac -> tac
+
   (* Check that holes in arguments have been resolved *)
 
   let check_evars env sigma extsigma origsigma =
@@ -501,7 +523,7 @@ module New = struct
     | [] -> ()
     | (evk,evi) :: _ ->
       let (loc,_) = evi.Evd.evar_source in
-      Pretype_errors.error_unsolvable_implicit loc env sigma evk None
+      Pretype_errors.error_unsolvable_implicit ~loc env sigma evk None
 
   let tclWITHHOLES accept_unresolved_holes tac sigma =
     tclEVARMAP >>= fun sigma_initial ->
@@ -514,7 +536,7 @@ module New = struct
                 try
                   let () = check_evars env sigma_final sigma sigma_initial in
                   tclUNIT x
-                with e when Errors.noncritical e ->
+                with e when CErrors.noncritical e ->
                   tclZERO e
           else
             tclUNIT x
@@ -525,7 +547,7 @@ module New = struct
     Proofview.Goal.nf_enter { enter = begin fun gl ->
       let env = Proofview.Goal.env gl in
       let sigma = Proofview.Goal.sigma gl in
-      let Sigma (x, sigma, _) = x.Tacexpr.delayed env sigma in
+      let Sigma (x, sigma, _) = x.delayed env sigma in
       tclWITHHOLES check (tac x) (Sigma.to_evar_map sigma)
     end }
 
@@ -533,7 +555,7 @@ module New = struct
     Proofview.tclOR
       (Proofview.tclTIMEOUT n t)
       begin function (e, info) -> match e with
-        | Proofview.Timeout as e -> Proofview.tclZERO (Refiner.FailError (0,lazy (Errors.print e)))
+        | Proofview.Timeout as e -> Proofview.tclZERO (Refiner.FailError (0,lazy (CErrors.print e)))
         | e -> Proofview.tclZERO ~info e
       end
 
@@ -544,7 +566,7 @@ module New = struct
     let hyps = Proofview.Goal.hyps gl in
     try
       List.nth hyps (m-1)
-    with Failure _ -> Errors.error "No such assumption."
+    with Failure _ -> CErrors.error "No such assumption."
 
   let nLastDecls gl n =
     try List.firstn n (Proofview.Goal.hyps gl)
@@ -553,7 +575,7 @@ module New = struct
   let nthHypId m gl =
     (** We only use [id] *)
     let gl = Proofview.Goal.assume gl in
-    nthDecl m gl |> get_id
+    nthDecl m gl |> NamedDecl.get_id
   let nthHyp m gl = 
     mkVar (nthHypId m gl)
 
@@ -583,9 +605,9 @@ module New = struct
   let onHyps find tac = Proofview.Goal.nf_enter { enter = begin fun gl -> tac (find.enter gl) end }
 
   let afterHyp id tac =
-    Proofview.Goal.nf_enter { enter = begin fun gl ->
-    let hyps = Proofview.Goal.hyps gl in
-    let rem, _ = List.split_when (Id.equal id % get_id) hyps in
+    Proofview.Goal.enter { enter = begin fun gl ->
+    let hyps = Proofview.Goal.hyps (Proofview.Goal.assume gl) in
+    let rem, _ = List.split_when (NamedDecl.get_id %> Id.equal id) hyps in
     tac rem
     end }
 
@@ -636,7 +658,7 @@ module New = struct
 	    | Var id -> string_of_id id
 	    | _ -> "\b"
 	  in
-	  errorlabstrm "Tacticals.general_elim_then_using"
+	  user_err ~hdr:"Tacticals.general_elim_then_using"
             (str "The elimination combinator " ++ str name_elim ++ str " is unknown.")
     in
     let elimclause' = clenv_fchain ~with_univs:false indmv elimclause indclause in
diff --git a/tactics/tacticals.mli b/tactics/tacticals.mli
index 0f926468b..7aacc52f3 100644
--- a/tactics/tacticals.mli
+++ b/tactics/tacticals.mli
@@ -11,9 +11,9 @@ open Names
 open Term
 open Tacmach
 open Proof_type
-open Tacexpr
 open Locus
 open Misctypes
+open Tactypes
 
 (** Tacticals i.e. functions from tactics to tactics. *)
 
@@ -209,6 +209,7 @@ module New : sig
   val tclMAP : ('a -> unit tactic) -> 'a list -> unit tactic
 
   val tclTRY : unit tactic -> unit tactic
+  val tclTRYb : unit tactic -> bool list tactic
   val tclFIRST : unit tactic list -> unit tactic
   val tclIFTHENELSE : unit tactic -> unit tactic -> unit tactic -> unit tactic
   val tclIFTHENSVELSE : unit tactic -> unit tactic array -> unit tactic -> unit tactic
@@ -221,6 +222,7 @@ module New : sig
   val tclCOMPLETE : 'a tactic -> 'a tactic
   val tclSOLVE : unit tactic list -> unit tactic
   val tclPROGRESS : unit tactic -> unit tactic
+  val tclSELECT : Vernacexpr.goal_selector -> 'a tactic -> 'a tactic
   val tclWITHHOLES : bool -> 'a tactic -> Evd.evar_map -> 'a tactic
   val tclDELAYEDWITHHOLES : bool -> 'a delayed_open -> ('a -> unit tactic) -> unit tactic
 
diff --git a/tactics/tactics.ml b/tactics/tactics.ml
index 75273e4b7..6205bd109 100644
--- a/tactics/tactics.ml
+++ b/tactics/tactics.ml
@@ -7,7 +7,7 @@
 (************************************************************************)
 
 open Pp
-open Errors
+open CErrors
 open Util
 open Names
 open Nameops
@@ -32,7 +32,6 @@ open Refiner
 open Tacticals
 open Hipattern
 open Coqlib
-open Tacexpr
 open Decl_kinds
 open Evarutil
 open Indrec
@@ -41,14 +40,23 @@ open Unification
 open Locus
 open Locusops
 open Misctypes
+open Tactypes
 open Proofview.Notations
 open Sigma.Notations
+open Context.Named.Declaration
+
+module RelDecl = Context.Rel.Declaration
+module NamedDecl = Context.Named.Declaration
 
 let inj_with_occurrences e = (AllOccurrences,e)
 
 let dloc = Loc.ghost
 
-let typ_of env sigma c = Retyping.get_type_of env (Sigma.to_evar_map sigma) c
+let typ_of env sigma c =
+  let open Retyping in
+  try get_type_of ~lax:true env (Sigma.to_evar_map sigma) c
+  with RetypeError e ->
+    user_err (print_retype_error e)
 
 open Goptions
 
@@ -79,7 +87,7 @@ let _ =
 
 let apply_solve_class_goals = ref (false)
 let _ = Goptions.declare_bool_option {
-  Goptions.optsync = true; Goptions.optdepr = false;
+  Goptions.optsync = true; Goptions.optdepr = true;
   Goptions.optname =
     "Perform typeclass resolution on apply-generated subgoals.";
   Goptions.optkey = ["Typeclass";"Resolution";"After";"Apply"];
@@ -119,12 +127,12 @@ let _ =
 
 (* Shrinking of abstract proofs. *)
 
-let shrink_abstract = ref false
+let shrink_abstract = ref true
 
 let _ =
   declare_bool_option
     { optsync  = true;
-      optdepr  = false;
+      optdepr  = true;
       optname  = "shrinking of abstracted proofs";
       optkey   = ["Shrink"; "Abstract"];
       optread  = (fun () -> !shrink_abstract) ;
@@ -162,30 +170,29 @@ let _ =
 (** This tactic creates a partial proof realizing the introduction rule, but
     does not check anything. *)
 let unsafe_intro env store decl b =
-  let open Context.Named.Declaration in
   Refine.refine ~unsafe:true { run = begin fun sigma ->
     let ctx = named_context_val env in
     let nctx = push_named_context_val decl ctx in
-    let inst = List.map (mkVar % get_id) (named_context env) in
+    let inst = List.map (NamedDecl.get_id %> mkVar) (named_context env) in
     let ninst = mkRel 1 :: inst in
-    let nb = subst1 (mkVar (get_id decl)) b in
+    let nb = subst1 (mkVar (NamedDecl.get_id decl)) b in
     let Sigma (ev, sigma, p) = new_evar_instance nctx sigma nb ~principal:true ~store ninst in
     Sigma (mkNamedLambda_or_LetIn decl ev, sigma, p)
   end }
 
 let introduction ?(check=true) id =
-  let open Context.Named.Declaration in
   Proofview.Goal.enter { enter = begin fun gl ->
     let gl = Proofview.Goal.assume gl in
     let concl = Proofview.Goal.concl gl in
     let sigma = Tacmach.New.project gl in
-    let hyps = Proofview.Goal.hyps gl in
+    let hyps = named_context_val (Proofview.Goal.env gl) in
     let store = Proofview.Goal.extra gl in
     let env = Proofview.Goal.env gl in
-    let () = if check && mem_named_context id hyps then
-      errorlabstrm "Tactics.introduction"
+    let () = if check && mem_named_context_val id hyps then
+      user_err ~hdr:"Tactics.introduction"
         (str "Variable " ++ pr_id id ++ str " is already declared.")
     in
+    let open Context.Named.Declaration in
     match kind_of_term (whd_evar sigma concl) with
     | Prod (_, t, b) -> unsafe_intro env store (LocalAssum (id, t)) b
     | LetIn (_, c, t, b) -> unsafe_intro env store (LocalDef (id, c, t)) b
@@ -255,7 +262,7 @@ let clear_dependency_msg env sigma id = function
       Printer.pr_existential env sigma ev ++ str"."
 
 let error_clear_dependency env sigma id err =
-  errorlabstrm "" (clear_dependency_msg env sigma id err)
+  user_err  (clear_dependency_msg env sigma id err)
 
 let replacing_dependency_msg env sigma id = function
   | Evarutil.OccurHypInSimpleClause None ->
@@ -269,7 +276,7 @@ let replacing_dependency_msg env sigma id = function
       Printer.pr_existential env sigma ev ++ str"."
 
 let error_replacing_dependency env sigma id err =
-  errorlabstrm "" (replacing_dependency_msg env sigma id err)
+  user_err  (replacing_dependency_msg env sigma id err)
 
 (* This tactic enables the user to remove hypotheses from the signature.
  * Some care is taken to prevent him from removing variables that are
@@ -313,11 +320,21 @@ let apply_clear_request clear_flag dft c =
   else Tacticals.New.tclIDTAC
 
 (* Moving hypotheses *)
-let move_hyp id dest = Proofview.V82.tactic (Tacmach.move_hyp id dest)
+let move_hyp id dest =
+  Proofview.Goal.enter { enter = begin fun gl ->
+    let env = Proofview.Goal.env gl in
+    let ty = Proofview.Goal.raw_concl gl in
+    let store = Proofview.Goal.extra gl in
+    let sign = named_context_val env in
+    let sign' = move_hyp_in_named_context id dest sign in
+    let env = reset_with_named_context sign' env in
+    Refine.refine ~unsafe:true { run = begin fun sigma ->
+      Evarutil.new_evar env sigma ~principal:true ~store ty
+    end }
+  end }
 
 (* Renaming hypotheses *)
 let rename_hyp repl =
-  let open Context.Named.Declaration in
   let fold accu (src, dst) = match accu with
   | None -> None
   | Some (srcs, dsts) ->
@@ -339,7 +356,7 @@ let rename_hyp repl =
       let concl = Proofview.Goal.concl gl in
       let store = Proofview.Goal.extra gl in
       (** Check that we do not mess variables *)
-      let fold accu decl = Id.Set.add (get_id decl) accu in
+      let fold accu decl = Id.Set.add (NamedDecl.get_id decl) accu in
       let vars = List.fold_left fold Id.Set.empty hyps in
       let () =
         if not (Id.Set.subset src vars) then
@@ -350,7 +367,7 @@ let rename_hyp repl =
       let () =
         try
           let elt = Id.Set.choose (Id.Set.inter dst mods) in
-          Errors.errorlabstrm "" (pr_id elt ++ str " is already used")
+          CErrors.user_err  (pr_id elt ++ str " is already used")
         with Not_found -> ()
       in
       (** All is well *)
@@ -358,15 +375,15 @@ let rename_hyp repl =
       let subst = List.map make_subst repl in
       let subst c = Vars.replace_vars subst c in
       let map decl =
-        decl |> map_id (fun id -> try List.assoc_f Id.equal id repl with Not_found -> id)
-             |> map_constr subst
+        decl |> NamedDecl.map_id (fun id -> try List.assoc_f Id.equal id repl with Not_found -> id)
+             |> NamedDecl.map_constr subst
       in
       let nhyps = List.map map hyps in
       let nconcl = subst concl in
       let nctx = Environ.val_of_named_context nhyps in
-      let instance = List.map (mkVar % get_id) hyps in
+      let instance = List.map (NamedDecl.get_id %> mkVar) hyps in
       Refine.refine ~unsafe:true { run = begin fun sigma ->
-        Evarutil.new_evar_instance nctx sigma nconcl ~store instance
+        Evarutil.new_evar_instance nctx sigma nconcl ~principal:true ~store instance
       end }
     end }
 
@@ -423,7 +440,7 @@ let find_name mayrepl decl naming gl = match naming with
       let ids_of_hyps = Tacmach.New.pf_ids_of_hyps gl in
       let id' = next_ident_away id ids_of_hyps in
       if not mayrepl && not (Id.equal id' id) then
-        user_err_loc (loc,"",pr_id id ++ str" is already used.");
+        user_err ~loc  (pr_id id ++ str" is already used.");
       id
 
 (**************************************************************)
@@ -507,8 +524,8 @@ let mutual_fix f n rest j = Proofview.Goal.nf_enter { enter = begin fun gl ->
     let (sp', u')  = check_mutind env sigma n ar in
     if not (eq_mind sp sp') then
       error "Fixpoints should be on the same mutual inductive declaration.";
-    if mem_named_context f (named_context_of_val sign) then
-      errorlabstrm "Logic.prim_refiner"
+    if mem_named_context_val f sign then
+      user_err ~hdr:"Logic.prim_refiner"
         (str "Name " ++ pr_id f ++ str " already used in the environment");
     mk_sign (push_named_context_val (LocalAssum (f, ar)) sign) oth
   in
@@ -537,7 +554,7 @@ let fix ido n = match ido with
     mutual_fix id n [] 0
 
 let rec check_is_mutcoind env sigma cl =
-  let b = whd_betadeltaiota env sigma cl in
+  let b = whd_all env sigma cl in
   match kind_of_term b with
   | Prod (na, c1, b) ->
     let open Context.Rel.Declaration in
@@ -560,7 +577,7 @@ let mutual_cofix f others j = Proofview.Goal.nf_enter { enter = begin fun gl ->
   | [] -> sign
   | (f, ar) :: oth ->
     let open Context.Named.Declaration in
-    if mem_named_context f (named_context_of_val sign) then
+    if mem_named_context_val f sign then
       error "Name already used in the environment.";
     mk_sign (push_named_context_val (LocalAssum (f, ar)) sign) oth
   in
@@ -599,7 +616,7 @@ let pf_reduce_decl redfun where decl gl =
   match decl with
   | LocalAssum (id,ty) ->
       if where == InHypValueOnly then
-	errorlabstrm "" (pr_id id ++ str " has no value.");
+	user_err  (pr_id id ++ str " has no value.");
       LocalAssum (id,redfun' ty)
   | LocalDef (id,b,ty) ->
       let b' = if where != InHypTypeOnly then redfun' b else b in
@@ -700,7 +717,7 @@ let pf_e_reduce_decl redfun where decl gl =
   match decl with
   | LocalAssum (id,ty) ->
       if where == InHypValueOnly then
-	errorlabstrm "" (pr_id id ++ str " has no value.");
+	user_err  (pr_id id ++ str " has no value.");
     let Sigma (ty', sigma, p) = redfun sigma ty in
     Sigma (LocalAssum (id, ty'), sigma, p)
   | LocalDef (id,b,ty) ->
@@ -740,7 +757,7 @@ let e_pf_change_decl (redfun : bool -> e_reduction_function) where decl env sigm
   match decl with
   | LocalAssum (id,ty) ->
       if where == InHypValueOnly then
-	errorlabstrm "" (pr_id id ++ str " has no value.");
+	user_err  (pr_id id ++ str " has no value.");
     let Sigma (ty', sigma, p) = (redfun false).e_redfun env sigma ty in
     Sigma (LocalAssum (id, ty'), sigma, p)
   | LocalDef (id,b,ty) ->
@@ -774,16 +791,16 @@ let check_types env sigma mayneedglobalcheck deep newc origc =
     let sigma, b = infer_conv ~pb:Reduction.CUMUL env sigma t1 t2 in
     if not b then
       if
-        isSort (whd_betadeltaiota env sigma t1) &&
-        isSort (whd_betadeltaiota env sigma t2)
+        isSort (whd_all env sigma t1) &&
+        isSort (whd_all env sigma t2)
       then (mayneedglobalcheck := true; sigma)
       else
-        errorlabstrm "convert-check-hyp" (str "Types are incompatible.")
+        user_err ~hdr:"convert-check-hyp" (str "Types are incompatible.")
     else sigma
   end
   else
-    if not (isSort (whd_betadeltaiota env sigma t1)) then
-      errorlabstrm "convert-check-hyp" (str "Not a type.")
+    if not (isSort (whd_all env sigma t1)) then
+      user_err ~hdr:"convert-check-hyp" (str "Not a type.")
     else sigma
 
 (* Now we introduce different instances of the previous tacticals *)
@@ -792,7 +809,7 @@ let change_and_check cv_pb mayneedglobalcheck deep t = { e_redfun = begin fun en
   let sigma = Sigma.to_evar_map sigma in
   let sigma = check_types env sigma mayneedglobalcheck deep t' c in
   let sigma, b = infer_conv ~pb:cv_pb env sigma t' c in
-  if not b then errorlabstrm "convert-check-hyp" (str "Not convertible.");
+  if not b then user_err ~hdr:"convert-check-hyp" (str "Not convertible.");
   Sigma.Unsafe.of_pair (t', sigma)
 end }
 
@@ -869,21 +886,28 @@ let reduction_clause redexp cl =
 	(None, bind_red_expr_occurrences occs nbcl redexp)) cl
 
 let reduce redexp cl =
+  let trace () =
+    let open Printer in
+    let pr = (pr_constr, pr_lconstr, pr_evaluable_reference, pr_constr_pattern) in
+    Pp.(hov 2 (Pputils.pr_red_expr pr str redexp))
+  in
+  Proofview.Trace.name_tactic trace begin
   Proofview.Goal.enter { enter = begin fun gl ->
-  let cl = concrete_clause_of (fun () -> Tacmach.New.pf_ids_of_hyps gl) cl in
-  let redexps = reduction_clause redexp cl in
+  let cl' = concrete_clause_of (fun () -> Tacmach.New.pf_ids_of_hyps gl) cl in
+  let redexps = reduction_clause redexp cl' in
   let check = match redexp with Fold _ | Pattern _ -> true | _ -> false in
   Tacticals.New.tclMAP (fun (where,redexp) ->
     e_reduct_option ~check
       (Redexpr.reduction_of_red_expr (Tacmach.New.pf_env gl) redexp) where) redexps
   end }
+  end
 
 (* Unfolding occurrences of a constant *)
 
 let unfold_constr = function
   | ConstRef sp -> unfold_in_concl [AllOccurrences,EvalConstRef sp]
   | VarRef id -> unfold_in_concl [AllOccurrences,EvalVarRef id]
-  | _ -> errorlabstrm "unfold_constr" (str "Cannot unfold a non-constant.")
+  | _ -> user_err ~hdr:"unfold_constr" (str "Cannot unfold a non-constant.")
 
 (*******************************************)
 (*         Introduction tactics            *)
@@ -982,23 +1006,21 @@ let intro_forthcoming_then_gen name_flag move_flag dep_flag n bound tac =
   aux n []
 
 let get_next_hyp_position id gl =
-  let open Context.Named.Declaration in
   let rec aux = function
   | [] -> raise (RefinerError (NoSuchHyp id))
   | decl :: right ->
-    if Id.equal (get_id decl) id then
-      match right with decl::_ -> MoveBefore (get_id decl) | [] -> MoveLast
+    if Id.equal (NamedDecl.get_id decl) id then
+      match right with decl::_ -> MoveBefore (NamedDecl.get_id decl) | [] -> MoveLast
     else
       aux right
   in
   aux (Proofview.Goal.hyps (Proofview.Goal.assume gl))
 
 let get_previous_hyp_position id gl =
-  let open Context.Named.Declaration in
   let rec aux dest = function
   | [] -> raise (RefinerError (NoSuchHyp id))
   | decl :: right ->
-      let hyp = get_id decl in
+      let hyp = NamedDecl.get_id decl in
       if Id.equal hyp id then dest else aux (MoveAfter hyp) right
   in
   aux MoveLast (Proofview.Goal.hyps (Proofview.Goal.assume gl))
@@ -1078,7 +1100,7 @@ let depth_of_quantified_hypothesis red h gl =
   match lookup_hypothesis_as_renamed_gen red h gl with
     | Some depth -> depth
     | None ->
-        errorlabstrm "lookup_quantified_hypothesis"
+        user_err ~hdr:"lookup_quantified_hypothesis"
           (str "No " ++ msg_quantified_hypothesis h ++
 	  strbrk " in current goal" ++
 	  (if red then strbrk " even after head-reduction" else mt ()) ++
@@ -1121,6 +1143,14 @@ let run_delayed env sigma c =
 (* Apply a tactic on a quantified hypothesis, an hypothesis in context
    or a term with bindings *)
 
+let tactic_infer_flags with_evar = {
+  Pretyping.use_typeclasses = true;
+  Pretyping.solve_unification_constraints = true;
+  Pretyping.use_hook = Some solve_by_implicit_tactic;
+  Pretyping.fail_evar = not with_evar;
+  Pretyping.expand_evars = true }
+
+
 let onOpenInductionArg env sigma tac = function
   | clear_flag,ElimOnConstr f ->
       let (cbl, sigma') = run_delayed env sigma f in
@@ -1161,10 +1191,25 @@ let onInductionArg tac = function
         (try_intros_until_id_check id)
         (tac clear_flag (mkVar id,NoBindings))
 
-let map_induction_arg f = function
-  | clear_flag,ElimOnConstr g -> clear_flag,ElimOnConstr (f g)
-  | clear_flag,ElimOnAnonHyp n as x -> x
-  | clear_flag,ElimOnIdent id as x -> x
+let map_destruction_arg f sigma = function
+  | clear_flag,ElimOnConstr g -> let sigma,x = f sigma g in (sigma, (clear_flag,ElimOnConstr x))
+  | clear_flag,ElimOnAnonHyp n as x -> (sigma,x)
+  | clear_flag,ElimOnIdent id as x -> (sigma,x)
+
+let finish_delayed_evar_resolution with_evars env sigma f =
+  let ((c, lbind), sigma') = run_delayed env sigma f in
+  let pending = (sigma,sigma') in
+  let sigma' = Sigma.Unsafe.of_evar_map sigma' in
+  let flags = tactic_infer_flags with_evars in
+  let Sigma (c, sigma', _) = finish_evar_resolution ~flags env sigma' (pending,c) in
+  (Sigma.to_evar_map sigma', (c, lbind))
+
+let with_no_bindings (c, lbind) =
+  if lbind != NoBindings then error "'with' clause not supported here.";
+  c
+
+let force_destruction_arg with_evars env sigma c =
+  map_destruction_arg (finish_delayed_evar_resolution with_evars env) sigma c
 
 (****************************************)
 (* tactic "cut" (actually modus ponens) *)
@@ -1181,7 +1226,7 @@ let cut c =
       try
         (** Backward compat: ensure that [c] is well-typed. *)
         let typ = Typing.unsafe_type_of env sigma c in
-        let typ = whd_betadeltaiota env sigma typ in
+        let typ = whd_all env sigma typ in
         match kind_of_term typ with
         | Sort _ -> true
         | _ -> false
@@ -1204,7 +1249,7 @@ let cut c =
 let error_uninstantiated_metas t clenv =
   let na = meta_name clenv.evd (List.hd (Metaset.elements (metavars_of t))) in
   let id = match na with Name id -> id | _ -> anomaly (Pp.str "unnamed dependent meta")
-  in errorlabstrm "" (str "Cannot find an instance for " ++ pr_id id ++ str".")
+  in user_err  (str "Cannot find an instance for " ++ pr_id id ++ str".")
 
 let check_unresolved_evars_of_metas sigma clenv =
   (* This checks that Metas turned into Evars by *)
@@ -1247,7 +1292,7 @@ let clenv_refine_in ?(sidecond_first=false) with_evars ?(with_classes=true)
   let naming = NamingMustBe (dloc,targetid) in
   let with_clear = do_replace (Some id) naming in
   Tacticals.New.tclTHEN
-    (Proofview.Unsafe.tclEVARS clenv.evd)
+    (Proofview.Unsafe.tclEVARS (clear_metas clenv.evd))
     (if sidecond_first then
        Tacticals.New.tclTHENFIRST
          (assert_before_then_gen with_clear naming new_hyp_typ tac) exact_tac
@@ -1337,7 +1382,7 @@ let elimination_clause_scheme with_evars ?(with_classes=true) ?(flags=elim_flags
   let indmv =
     (match kind_of_term (nth_arg i elimclause.templval.rebus) with
        | Meta mv -> mv
-       | _  -> errorlabstrm "elimination_clause"
+       | _  -> user_err ~hdr:"elimination_clause"
              (str "The type of elimination clause is not well-formed."))
   in
   let elimclause' = clenv_fchain ~flags indmv elimclause indclause in
@@ -1416,6 +1461,7 @@ let general_case_analysis with_evars clear_flag (c,lbindc as cx) =
         general_case_analysis_in_context with_evars clear_flag cx
 
 let simplest_case c = general_case_analysis false None (c,NoBindings)
+let simplest_ecase c = general_case_analysis true None (c,NoBindings)
 
 (* Elimination tactic with bindings but using the default elimination
  * constant associated with the type. *)
@@ -1448,7 +1494,7 @@ let default_elim with_evars clear_flag (c,_ as cx) =
     begin function (e, info) -> match e with
       | IsNonrec ->
           (* For records, induction principles aren't there by default
-             anymore.  Instead, we do a case analysis instead. *)
+             anymore.  Instead, we do a case analysis. *)
           general_case_analysis with_evars clear_flag cx
       | e -> Proofview.tclZERO ~info e
     end
@@ -1501,7 +1547,7 @@ let elimination_in_clause_scheme with_evars ?(flags=elim_flags ())
     try match List.remove Int.equal indmv (clenv_independent elimclause) with
       | [a] -> a
       | _ -> failwith ""
-    with Failure _ -> errorlabstrm "elimination_clause"
+    with Failure _ -> user_err ~hdr:"elimination_clause"
           (str "The type of elimination clause is not well-formed.") in
   let elimclause'  = clenv_fchain ~flags indmv elimclause indclause in
   let hyp = mkVar id in
@@ -1510,7 +1556,7 @@ let elimination_in_clause_scheme with_evars ?(flags=elim_flags ())
   let elimclause'' = clenv_fchain_in id ~flags hypmv elimclause' hypclause in
   let new_hyp_typ  = clenv_type elimclause'' in
   if Term.eq_constr hyp_typ new_hyp_typ then
-    errorlabstrm "general_rewrite_in"
+    user_err ~hdr:"general_rewrite_in"
       (str "Nothing to rewrite in " ++ pr_id id ++ str".");
   clenv_refine_in with_evars id id sigma elimclause''
     (fun id -> Proofview.tclUNIT ())
@@ -1535,7 +1581,7 @@ let make_projection env sigma params cstr sign elim i n c u =
   | NotADefinedRecordUseScheme elim ->
       (* bugs: goes from right to left when i increases! *)
       let decl = List.nth cstr.cs_args i in
-      let t = get_type decl in
+      let t = RelDecl.get_type decl in
       let b = match decl with LocalAssum _ -> mkRel (i+1) | LocalDef (_,b,_) -> b in
       let branch = it_mkLambda_or_LetIn b cstr.cs_args in
       if
@@ -1661,7 +1707,7 @@ let general_apply with_delta with_destruct with_evars clear_flag (loc,(c,lbind))
         if n<0 then error "Applied theorem has not enough premisses.";
         let clause = make_clenv_binding_apply env sigma (Some n) (c,thm_ty) lbind in
         Clenvtac.res_pf clause ~with_evars ~flags
-      with UserError _ as exn ->
+      with exn when catchable_exception exn ->
         Proofview.tclZERO exn
     in
     let rec try_red_apply thm_ty (exn0, info) =
@@ -1783,8 +1829,8 @@ let apply_in_once_main flags innerclause env sigma (d,lbind) =
   let thm = nf_betaiota sigma (Retyping.get_type_of env sigma d) in
   let rec aux clause =
     try progress_with_clause flags innerclause clause
-    with e when Errors.noncritical e ->
-    let e = Errors.push e in
+    with e when CErrors.noncritical e ->
+    let e = CErrors.push e in
     try aux (clenv_push_prod clause)
     with NotExtensibleClause -> iraise e
   in
@@ -1814,8 +1860,8 @@ let apply_in_once sidecond_first with_delta with_destruct with_evars naming
             clear idstoclear;
             tac id
           ])
-    with e when with_destruct && Errors.noncritical e ->
-      let (e, info) = Errors.push e in
+    with e when with_destruct && CErrors.noncritical e ->
+      let (e, info) = CErrors.push e in
         (descend_in_conjunctions [targetid]
            (fun b id -> aux (id::idstoclear) b (mkVar id))
            (e, info) c)
@@ -1899,9 +1945,7 @@ let exact_check c =
 let cast_no_check cast c =
   Proofview.Goal.enter { enter = begin fun gl ->
     let concl = Proofview.Goal.concl (Proofview.Goal.assume gl) in
-    Refine.refine ~unsafe:true { run = begin fun sigma ->
-      Sigma.here (Term.mkCast (c, cast, concl)) sigma
-    end }
+    exact_no_check (Term.mkCast (c, cast, concl))
   end }
 
 let vm_cast_no_check c = cast_no_check Term.VMcast c
@@ -1919,7 +1963,6 @@ let exact_proof c =
   end }
 
 let assumption =
-  let open Context.Named.Declaration in
   let rec arec gl only_eq = function
   | [] ->
     if only_eq then
@@ -1927,7 +1970,7 @@ let assumption =
       arec gl false hyps
     else Tacticals.New.tclZEROMSG (str "No such assumption.")
   | decl::rest ->
-    let t = get_type decl in
+    let t = NamedDecl.get_type decl in
     let concl = Proofview.Goal.concl gl in
     let sigma = Tacmach.New.project gl in
     let (sigma, is_same_type) =
@@ -1938,7 +1981,7 @@ let assumption =
     in
     if is_same_type then
       (Proofview.Unsafe.tclEVARS sigma) <*>
-	Refine.refine ~unsafe:true { run = fun h -> Sigma.here (mkVar (get_id decl)) h }
+	exact_no_check (mkVar (NamedDecl.get_id decl))
     else arec gl only_eq rest
   in
   let assumption_tac = { enter = begin fun gl ->
@@ -1963,12 +2006,12 @@ let check_is_type env sigma ty =
   try
     let _ = Typing.e_sort_of env evdref ty in
     !evdref
-  with e when Errors.noncritical e ->
+  with e when CErrors.noncritical e ->
     raise (DependsOnBody None)
 
 let check_decl env sigma decl =
   let open Context.Named.Declaration in
-  let ty = get_type decl in
+  let ty = NamedDecl.get_type decl in
   let evdref = ref sigma in
   try
     let _ = Typing.e_sort_of env evdref ty in
@@ -1977,8 +2020,8 @@ let check_decl env sigma decl =
     | LocalDef (_,c,_) -> Typing.e_check env evdref c ty
     in
     !evdref
-  with e when Errors.noncritical e ->
-    let id = get_id decl in
+  with e when CErrors.noncritical e ->
+    let id = NamedDecl.get_id decl in
     raise (DependsOnBody (Some id))
 
 let clear_body ids =
@@ -1991,7 +2034,7 @@ let clear_body ids =
     let map = function
     | LocalAssum (id,t) as decl ->
       let () = if List.mem_f Id.equal id ids then
-        errorlabstrm "" (str "Hypothesis " ++ pr_id id ++ str " is not a local definition")
+        user_err  (str "Hypothesis " ++ pr_id id ++ str " is not a local definition")
       in
       decl
     | LocalDef (id,_,t) as decl ->
@@ -2002,16 +2045,18 @@ let clear_body ids =
     let env = push_named_context ctx base_env in
     let check =
       try
-        let check (env, sigma) decl =
+        let check (env, sigma, seen) decl =
           (** Do no recheck hypotheses that do not depend *)
           let sigma =
-            if List.exists (fun id -> occur_var_in_decl env id decl) ids then
+            if not seen then sigma
+            else if List.exists (fun id -> occur_var_in_decl env id decl) ids then
               check_decl env sigma decl
             else sigma
           in
-          (push_named decl env, sigma)
+          let seen = seen || List.mem_f Id.equal (NamedDecl.get_id decl) ids in
+          (push_named decl env, sigma, seen)
         in
-        let (env, sigma) = List.fold_left check (base_env, sigma) (List.rev ctx) in
+        let (env, sigma, _) = List.fold_left check (base_env, sigma, false) (List.rev ctx) in
         let sigma =
           if List.exists (fun id -> occur_var env id concl) ids then
             check_is_type env sigma concl
@@ -2048,13 +2093,12 @@ let rec intros_clearing = function
 (* Keeping only a few hypotheses *)
 
 let keep hyps =
-  let open Context.Named.Declaration in
   Proofview.Goal.nf_enter { enter = begin fun gl ->
   Proofview.tclENV >>= fun env ->
   let ccl = Proofview.Goal.concl gl in
   let cl,_ =
     fold_named_context_reverse (fun (clear,keep) decl ->
-      let hyp = get_id decl in
+      let hyp = NamedDecl.get_id decl in
       if Id.List.mem hyp hyps
         || List.exists (occur_var_in_decl env hyp) keep
 	|| occur_var env hyp ccl
@@ -2120,7 +2164,7 @@ let check_number_of_constructors expctdnumopt i nconstr =
   if Int.equal i 0 then error "The constructors are numbered starting from 1.";
   begin match expctdnumopt with
     | Some n when not (Int.equal n nconstr) ->
-	errorlabstrm "Tactics.check_number_of_constructors"
+	user_err ~hdr:"Tactics.check_number_of_constructors"
           (str "Not an inductive goal with " ++ int n ++ str (String.plural n " constructor") ++ str ".")
     | _ -> ()
   end;
@@ -2209,7 +2253,7 @@ let error_unexpected_extra_pattern loc bound pat =
   | IntroNaming (IntroIdentifier _) ->
       "name", (String.plural nb " introduction pattern"), "no"
   | _ -> "introduction pattern", "", "none" in
-  user_err_loc (loc,"",str "Unexpected " ++ str s1 ++ str " (" ++
+  user_err ~loc  (str "Unexpected " ++ str s1 ++ str " (" ++
     (if Int.equal nb 0 then (str s3 ++ str s2) else
       (str "at most " ++ int nb ++ str s2)) ++ spc () ++
        str (if Int.equal nb 1 then "was" else "were") ++
@@ -2241,7 +2285,7 @@ let intro_decomp_eq loc l thin tac id =
     Tacticals.New.tclZEROMSG (str "Not a primitive equality here.")
   end }
 
-let intro_or_and_pattern loc bracketed ll thin tac id =
+let intro_or_and_pattern loc with_evars bracketed ll thin tac id =
   Proofview.Goal.enter { enter = begin fun gl ->
   let c = mkVar id in
   let t = Tacmach.New.pf_unsafe_type_of gl c in
@@ -2251,14 +2295,14 @@ let intro_or_and_pattern loc bracketed ll thin tac id =
   let ll = fix_empty_or_and_pattern (Array.length branchsigns) ll in
   let ll = get_and_check_or_and_pattern loc ll branchsigns in
   Tacticals.New.tclTHENLASTn
-    (Tacticals.New.tclTHEN (simplest_case c) (clear [id]))
+    (Tacticals.New.tclTHEN (simplest_ecase c) (clear [id]))
     (Array.map2 (fun n l -> tac thin (Some (bracketed,n)) l)
        nv_with_let ll)
   end }
 
-let rewrite_hyp_then assert_style thin l2r id tac =
+let rewrite_hyp_then assert_style with_evars thin l2r id tac =
   let rew_on l2r =
-    Hook.get forward_general_rewrite_clause l2r false (mkVar id,NoBindings) in
+    Hook.get forward_general_rewrite_clause l2r with_evars (mkVar id,NoBindings) in
   let subst_on l2r x rhs =
     Hook.get forward_subst_one true x (id,rhs,l2r) in
   let clear_var_and_eq id' = clear [id';id] in
@@ -2267,8 +2311,8 @@ let rewrite_hyp_then assert_style thin l2r id tac =
   Proofview.Goal.enter { enter = begin fun gl ->
     let env = Proofview.Goal.env gl in
     let type_of = Tacmach.New.pf_unsafe_type_of gl in
-    let whd_betadeltaiota = Tacmach.New.pf_apply whd_betadeltaiota gl in
-    let t = whd_betadeltaiota (type_of (mkVar id)) in
+    let whd_all = Tacmach.New.pf_apply whd_all gl in
+    let t = whd_all (type_of (mkVar id)) in
     let eqtac, thin = match match_with_equality_type t with
     | Some (hdcncl,[_;lhs;rhs]) ->
         if l2r && isVar lhs && not (occur_var env (destVar lhs) rhs) then
@@ -2369,12 +2413,13 @@ let exceed_bound n = function
      [patl]: introduction patterns to interpret
   *)
 
-let rec intro_patterns_core b avoid ids thin destopt bound n tac = function
+let rec intro_patterns_core with_evars b avoid ids thin destopt bound n tac =
+  function
   | [] when fit_bound n bound ->
       tac ids thin
   | [] ->
       (* Behave as IntroAnonymous *)
-      intro_patterns_core b avoid ids thin destopt bound n tac
+      intro_patterns_core with_evars b avoid ids thin destopt bound n tac
         [dloc,IntroNaming IntroAnonymous]
   | (loc,pat) :: l ->
   if exceed_bound n bound then error_unexpected_extra_pattern loc bound pat else
@@ -2382,48 +2427,49 @@ let rec intro_patterns_core b avoid ids thin destopt bound n tac = function
   | IntroForthcoming onlydeps ->
       intro_forthcoming_then_gen (NamingAvoid (avoid@explicit_intro_names l))
 	  destopt onlydeps n bound
-        (fun ids -> intro_patterns_core b avoid ids thin destopt bound
+        (fun ids -> intro_patterns_core with_evars b avoid ids thin destopt bound
           (n+List.length ids) tac l)
   | IntroAction pat ->
       intro_then_gen (make_tmp_naming avoid l pat)
 	destopt true false
-        (intro_pattern_action loc (b || not (List.is_empty l)) false pat thin
-          destopt
-          (fun thin bound' -> intro_patterns_core b avoid ids thin destopt bound' 0
+        (intro_pattern_action loc with_evars (b || not (List.is_empty l)) false
+          pat thin destopt
+          (fun thin bound' -> intro_patterns_core with_evars b avoid ids thin destopt bound' 0
             (fun ids thin ->
-              intro_patterns_core b avoid ids thin destopt bound (n+1) tac l)))
+              intro_patterns_core with_evars b avoid ids thin destopt bound (n+1) tac l)))
   | IntroNaming pat ->
-      intro_pattern_naming loc b avoid ids pat thin destopt bound (n+1) tac l
+      intro_pattern_naming loc with_evars b avoid ids pat thin destopt bound (n+1) tac l
 
   (* Pi-introduction rule, used backwards *)
-and intro_pattern_naming loc b avoid ids pat thin destopt bound n tac l =
+and intro_pattern_naming loc with_evars b avoid ids pat thin destopt bound n tac l =
   match pat with
   | IntroIdentifier id ->
       check_thin_clash_then id thin avoid (fun thin ->
         intro_then_gen (NamingMustBe (loc,id)) destopt true false
-          (fun id -> intro_patterns_core b avoid (id::ids) thin destopt bound n tac l))
+          (fun id -> intro_patterns_core with_evars b avoid (id::ids) thin destopt bound n tac l))
   | IntroAnonymous ->
       intro_then_gen (NamingAvoid (avoid@explicit_intro_names l))
 	destopt true false
-        (fun id -> intro_patterns_core b avoid (id::ids) thin destopt bound n tac l)
+        (fun id -> intro_patterns_core with_evars b avoid (id::ids) thin destopt bound n tac l)
   | IntroFresh id ->
       (* todo: avoid thinned names to interfere with generation of fresh name *)
       intro_then_gen (NamingBasedOn (id, avoid@explicit_intro_names l))
 	destopt true false
-        (fun id -> intro_patterns_core b avoid (id::ids) thin destopt bound n tac l)
+        (fun id -> intro_patterns_core with_evars b avoid (id::ids) thin destopt bound n tac l)
 
-and intro_pattern_action loc b style pat thin destopt tac id = match pat with
+and intro_pattern_action loc with_evars b style pat thin destopt tac id =
+  match pat with
   | IntroWildcard ->
       tac ((loc,id)::thin) None []
   | IntroOrAndPattern ll ->
-      intro_or_and_pattern loc b ll thin tac id
+      intro_or_and_pattern loc with_evars b ll thin tac id
   | IntroInjection l' ->
       intro_decomp_eq loc l' thin tac id
   | IntroRewrite l2r ->
-      rewrite_hyp_then style thin l2r id (fun thin -> tac thin None [])
+      rewrite_hyp_then style with_evars thin l2r id (fun thin -> tac thin None [])
   | IntroApplyOn (f,(loc,pat)) ->
       let naming,tac_ipat =
-        prepare_intros_loc loc (IntroIdentifier id) destopt pat in
+        prepare_intros_loc loc with_evars (IntroIdentifier id) destopt pat in
       let doclear =
         if naming = NamingMustBe (loc,id) then
           Proofview.tclUNIT () (* apply_in_once do a replacement *)
@@ -2433,47 +2479,48 @@ and intro_pattern_action loc b style pat thin destopt tac id = match pat with
         let Sigma (c, sigma, p) = f.delayed env sigma in
         Sigma ((c, NoBindings), sigma, p)
       } in
-      apply_in_delayed_once false true true true naming id (None,(loc,f))
+      apply_in_delayed_once false true true with_evars naming id (None,(loc,f))
         (fun id -> Tacticals.New.tclTHENLIST [doclear; tac_ipat id; tac thin None []])
 
-and prepare_intros_loc loc dft destopt = function
+and prepare_intros_loc loc with_evars dft destopt = function
   | IntroNaming ipat ->
       prepare_naming loc ipat,
       (fun id -> move_hyp id destopt)
   | IntroAction ipat ->
       prepare_naming loc dft,
       (let tac thin bound =
-        intro_patterns_core true [] [] thin destopt bound 0
+        intro_patterns_core with_evars true [] [] thin destopt bound 0
           (fun _ l -> clear_wildcards l) in
-      fun id -> intro_pattern_action loc true true ipat [] destopt tac id)
-  | IntroForthcoming _ -> user_err_loc
-      (loc,"",str "Introduction pattern for one hypothesis expected.")
+      fun id ->
+        intro_pattern_action loc with_evars true true ipat [] destopt tac id)
+  | IntroForthcoming _ -> user_err ~loc 
+      (str "Introduction pattern for one hypothesis expected.")
 
-let intro_patterns_bound_to n destopt =
-  intro_patterns_core true [] [] [] destopt
+let intro_patterns_bound_to with_evars n destopt =
+  intro_patterns_core with_evars true [] [] [] destopt
     (Some (true,n)) 0 (fun _ l -> clear_wildcards l)
 
-let intro_patterns_to destopt =
-  intro_patterns_core (use_bracketing_last_or_and_intro_pattern ())
+let intro_patterns_to with_evars destopt =
+  intro_patterns_core with_evars (use_bracketing_last_or_and_intro_pattern ())
     [] [] [] destopt None 0 (fun _ l -> clear_wildcards l)
 
-let intro_pattern_to destopt pat =
-  intro_patterns_to destopt [dloc,pat]
+let intro_pattern_to with_evars destopt pat =
+  intro_patterns_to with_evars destopt [dloc,pat]
 
-let intro_patterns = intro_patterns_to MoveLast
+let intro_patterns with_evars = intro_patterns_to with_evars MoveLast
 
 (* Implements "intros" *)
-let intros_patterns = function
+let intros_patterns with_evars = function
   | [] -> intros
-  | l -> intro_patterns_to MoveLast l
+  | l -> intro_patterns_to with_evars MoveLast l
 
 (**************************)
 (*   Forward reasoning    *)
 (**************************)
 
-let prepare_intros dft destopt = function
+let prepare_intros with_evars dft destopt = function
   | None -> prepare_naming dloc dft, (fun _id -> Proofview.tclUNIT ())
-  | Some (loc,ipat) -> prepare_intros_loc loc dft destopt ipat
+  | Some (loc,ipat) -> prepare_intros_loc loc with_evars dft destopt ipat
 
 let ipat_of_name = function
   | Anonymous -> None
@@ -2484,7 +2531,7 @@ let head_ident c =
    if isVar c then Some (destVar c) else None
 
 let assert_as first hd ipat t =
-  let naming,tac = prepare_intros IntroAnonymous MoveLast ipat in
+  let naming,tac = prepare_intros false IntroAnonymous MoveLast ipat in
   let repl = do_replace hd naming in
   let tac = if repl then (fun id -> Proofview.tclUNIT ()) else tac in
   if first then assert_before_then_gen repl naming t tac
@@ -2501,7 +2548,8 @@ let general_apply_in sidecond_first with_delta with_destruct with_evars
   let destopt =
     if with_evars then MoveLast (* evars would depend on the whole context *)
     else get_previous_hyp_position id gl in
-  let naming,ipat_tac = prepare_intros (IntroIdentifier id) destopt ipat in
+  let naming,ipat_tac =
+    prepare_intros with_evars (IntroIdentifier id) destopt ipat in
   let lemmas_target, last_lemma_target =
     let last,first = List.sep_last lemmas in
     List.map (fun lem -> (NamingMustBe (dloc,id),lem)) first, (naming,last)
@@ -2532,13 +2580,6 @@ let apply_delayed_in simple with_evars id lemmas ipat =
 (* Implementation without generalisation: abbrev will be lost in hyps in *)
 (* in the extracted proof *)
 
-let tactic_infer_flags with_evar = {
-  Pretyping.use_typeclasses = true;
-  Pretyping.use_unif_heuristics = true;
-  Pretyping.use_hook = Some solve_by_implicit_tactic;
-  Pretyping.fail_evar = not with_evar;
-  Pretyping.expand_evars = true }
-
 let decode_hyp = function
   | None -> MoveLast
   | Some id -> MoveAfter id
@@ -2595,13 +2636,12 @@ let letin_tac_gen with_eq (id,depdecls,lastlhyp,ccl,c) ty =
   end }
 
 let insert_before decls lasthyp env =
-  let open Context.Named.Declaration in
   match lasthyp with
   | None -> push_named_context decls env
   | Some id ->
   Environ.fold_named_context
     (fun _ d env ->
-      let env = if Id.equal id (get_id d) then push_named_context decls env else env in
+      let env = if Id.equal id (NamedDecl.get_id d) then push_named_context decls env else env in
       push_named d env)
     ~init:(reset_context env) env
 
@@ -2620,7 +2660,7 @@ let mkletin_goal env sigma store with_eq dep (id,lastlhyp,ccl,c) ty =
       | IntroFresh heq_base -> fresh_id_in_env [id] heq_base env
       | IntroIdentifier id ->
           if List.mem id (ids_of_named_context (named_context env)) then
-            user_err_loc (loc,"",pr_id id ++ str" is already used.");
+            user_err ~loc  (pr_id id ++ str" is already used.");
           id in
       let eqdata = build_coq_eq_data () in
       let args = if lr then [t;mkVar id;c] else [t;c;mkVar id]in
@@ -2642,10 +2682,15 @@ let letin_tac with_eq id c ty occs =
     let env = Proofview.Goal.env gl in
     let ccl = Proofview.Goal.concl gl in
     let abs = AbstractExact (id,c,ty,occs,true) in
-    let (id,_,depdecls,lastlhyp,ccl,_) = make_abstraction env sigma ccl abs in
-    (* We keep the original term to match *)
+    let (id,_,depdecls,lastlhyp,ccl,res) = make_abstraction env sigma ccl abs in
+    (* We keep the original term to match but record the potential side-effects
+       of unifying universes. *)
+    let Sigma (c, sigma, p) = match res with
+      | None -> Sigma.here c sigma
+      | Some (Sigma (_, sigma, p)) -> Sigma (c, sigma, p)
+    in
     let tac = letin_tac_gen with_eq (id,depdecls,lastlhyp,ccl,c) ty in
-    Sigma.here tac sigma
+    Sigma (tac, sigma, p)
   end }
 
 let letin_pat_tac with_eq id c occs =
@@ -2670,11 +2715,14 @@ let forward b usetac ipat c =
   match usetac with
   | None ->
       Proofview.Goal.enter { enter = begin fun gl ->
-      let t = Tacmach.New.pf_unsafe_type_of gl c in
+      let t = Tacmach.New.pf_get_type_of gl c in
       let hd = head_ident c in
       Tacticals.New.tclTHENFIRST (assert_as true hd ipat t) (exact_no_check c)
       end }
   | Some tac ->
+      let tac = match tac with
+        | None -> Tacticals.New.tclIDTAC
+        | Some tac -> Tacticals.New.tclCOMPLETE tac in
       if b then
         Tacticals.New.tclTHENFIRST (assert_as b None ipat c) tac
       else
@@ -2682,8 +2730,8 @@ let forward b usetac ipat c =
           (assert_as b None ipat c) [||] tac [|Tacticals.New.tclIDTAC|]
 
 let pose_proof na c = forward true None (ipat_of_name na) c
-let assert_by na t tac = forward true (Some tac) (ipat_of_name na) t
-let enough_by na t tac = forward false (Some tac) (ipat_of_name na) t
+let assert_by na t tac = forward true (Some (Some tac)) (ipat_of_name na) t
+let enough_by na t tac = forward false (Some (Some tac)) (ipat_of_name na) t
 
 (***************************)
 (*  Generalization tactics *)
@@ -2694,7 +2742,7 @@ let enough_by na t tac = forward false (Some tac) (ipat_of_name na) t
 let generalized_name c t ids cl = function
   | Name id as na ->
       if Id.List.mem id ids then
-	errorlabstrm "" (pr_id id ++ str " is already used.");
+	user_err  (pr_id id ++ str " is already used.");
       na
   | Anonymous ->
       match kind_of_term c with
@@ -2732,23 +2780,22 @@ let generalize_goal gl i ((occs,c,b),na as o) (cl,sigma) =
   generalize_goal_gen env sigma ids i o t cl
 
 let old_generalize_dep ?(with_let=false) c gl =
-  let open Context.Named.Declaration in
   let env = pf_env gl in
   let sign = pf_hyps gl in
   let init_ids = ids_of_named_context (Global.named_context()) in
   let seek (d:Context.Named.Declaration.t) (toquant:Context.Named.t) =
-    if List.exists (fun d' -> occur_var_in_decl env (get_id d') d) toquant
+    if List.exists (fun d' -> occur_var_in_decl env (NamedDecl.get_id d') d) toquant
       || dependent_in_decl c d then
       d::toquant
     else
       toquant in
   let to_quantify = Context.Named.fold_outside seek sign ~init:[] in
   let to_quantify_rev = List.rev to_quantify in
-  let qhyps = List.map get_id to_quantify_rev in
+  let qhyps = List.map NamedDecl.get_id to_quantify_rev in
   let tothin = List.filter (fun id -> not (Id.List.mem id init_ids)) qhyps in
   let tothin' =
     match kind_of_term c with
-      | Var id when mem_named_context id sign && not (Id.List.mem id init_ids)
+      | Var id when mem_named_context_val id (val_of_named_context sign) && not (Id.List.mem id init_ids)
 	  -> id::tothin
       | _ -> tothin
   in
@@ -2756,12 +2803,14 @@ let old_generalize_dep ?(with_let=false) c gl =
   let body =
     if with_let then
       match kind_of_term c with
-      | Var id -> Tacmach.pf_get_hyp gl id |> get_value
+      | Var id -> id |> Tacmach.pf_get_hyp gl |> NamedDecl.get_value
       | _ -> None
     else None
   in
   let cl'',evd = generalize_goal gl 0 ((AllOccurrences,c,body),Anonymous)
     (cl',project gl) in
+  (** Check that the generalization is indeed well-typed *)
+  let (evd, _) = Typing.type_of env evd cl'' in
   let args = Context.Named.to_instance to_quantify_rev in
   tclTHENLIST
     [tclEVARS evd;
@@ -2774,10 +2823,12 @@ let generalize_dep ?(with_let = false) c =
 
 (**  *)
 let generalize_gen_let lconstr = Proofview.Goal.nf_s_enter { s_enter = begin fun gl ->
+  let env = Proofview.Goal.env gl in
   let newcl, evd =
     List.fold_right_i (Tacmach.New.of_old generalize_goal gl) 0 lconstr
       (Tacmach.New.pf_concl gl,Tacmach.New.project gl)
   in
+  let (evd, _) = Typing.type_of env evd newcl in
   let map ((_, c, b),_) = if Option.is_empty b then Some c else None in
   let tac = apply_type newcl (List.map_filter map lconstr) in
   Sigma.Unsafe.of_pair (tac, evd)
@@ -2835,7 +2886,7 @@ let quantify lconstr =
 
 (* Modifying/Adding an hypothesis  *)
 
-let specialize (c,lbind) =
+let specialize (c,lbind) ipat =
   Proofview.Goal.enter { enter = begin fun gl ->
   let env = Proofview.Goal.env gl in
   let sigma = Sigma.to_evar_map (Proofview.Goal.sigma gl) in
@@ -2855,25 +2906,37 @@ let specialize (c,lbind) =
       let tstack = chk tstack in
       let term = applist(thd,List.map (nf_evar clause.evd) tstack) in
       if occur_meta term then
-	errorlabstrm "" (str "Cannot infer an instance for " ++
+	user_err  (str "Cannot infer an instance for " ++
+
           pr_name (meta_name clause.evd (List.hd (collect_metas term))) ++
 	  str ".");
       clause.evd, term in
   let typ = Retyping.get_type_of env sigma term in
-  match kind_of_term (fst(decompose_app (snd(decompose_lam_assum c)))) with
-  | Var id when Id.List.mem id (Tacmach.New.pf_ids_of_hyps gl) ->
-      Tacticals.New.tclTHEN
-        (Proofview.Unsafe.tclEVARS sigma)
-	(Tacticals.New.tclTHENFIRST
-	   (assert_before_replacing id typ)
-	   (exact_no_check term))
-  | _ ->
-      (* To deprecate in favor of generalize? *)
-      Tacticals.New.tclTHEN
-        (Proofview.Unsafe.tclEVARS sigma)
-	(Tacticals.New.tclTHENLAST
-           (cut typ)
-           (exact_no_check term))
+  let tac =
+    match kind_of_term (fst(decompose_app (snd(decompose_lam_assum c)))) with
+    | Var id when Id.List.mem id (Tacmach.New.pf_ids_of_hyps gl) ->
+      (* Like assert (id:=id args) but with the concept of specialization *)
+      let naming,tac =
+        prepare_intros false (IntroIdentifier id) MoveLast ipat in
+      let repl = do_replace (Some id) naming in
+      Tacticals.New.tclTHENFIRST
+        (assert_before_then_gen repl naming typ tac)
+	(exact_no_check term)
+    | _ ->
+      match ipat with
+      | None ->
+        (* Like generalize with extra support for "with" bindings *)
+        (* even though the "with" bindings forces full application *)
+        Tacticals.New.tclTHENLAST (cut typ) (exact_no_check term)
+      | Some (loc,ipat) ->
+        (* Like pose proof with extra support for "with" bindings *)
+        (* even though the "with" bindings forces full application *)
+        let naming,tac = prepare_intros_loc loc false IntroAnonymous MoveLast ipat in
+        Tacticals.New.tclTHENFIRST
+          (assert_before_then_gen false naming typ tac)
+	  (exact_no_check term)
+  in
+  Tacticals.New.tclTHEN (Proofview.Unsafe.tclEVARS sigma) tac
   end }
 
 (*****************************)
@@ -2886,16 +2949,15 @@ let unfold_body x =
   let open Context.Named.Declaration in
   Proofview.Goal.enter { enter = begin fun gl ->
   (** We normalize the given hypothesis immediately. *)
-  let hyps = Proofview.Goal.hyps (Proofview.Goal.assume gl) in
-  let xval = match Context.Named.lookup x hyps with
-  | LocalAssum _ -> errorlabstrm "unfold_body"
+  let env = Proofview.Goal.env (Proofview.Goal.assume gl) in
+  let xval = match Environ.lookup_named x env with
+  | LocalAssum _ -> user_err ~hdr:"unfold_body"
     (pr_id x ++ str" is not a defined hypothesis.")
-  | LocalDef (_,xval,_) -> pf_nf_evar gl xval
+  | LocalDef (_,xval,_) -> xval
   in
   Tacticals.New.afterHyp x begin fun aft ->
-  let hl = List.fold_right (fun decl cl -> (get_id decl, InHyp) :: cl) aft [] in
-  let xvar = mkVar x in
-  let rfun _ _ c = replace_term xvar xval c in
+  let hl = List.fold_right (fun decl cl -> (NamedDecl.get_id decl, InHyp) :: cl) aft [] in
+  let rfun _ _ c = replace_vars [x, xval] c in
   let reducth h = reduct_in_hyp rfun h in
   let reductc = reduct_in_concl (rfun, DEFAULTcast) in
   Tacticals.New.tclTHENLIST [Tacticals.New.tclMAP reducth hl; reductc]
@@ -2939,13 +3001,17 @@ let expand_hyp id = Tacticals.New.tclTRY (unfold_body id) <*> clear [id]
 
  *)
 
+let warn_unused_intro_pattern =
+  CWarnings.create ~name:"unused-intro-pattern" ~category:"tactics"
+         (fun names ->
+          strbrk"Unused introduction " ++ str (String.plural (List.length names) "pattern")
+          ++ str": " ++ prlist_with_sep spc 
+         (Miscprint.pr_intro_pattern 
+	 (fun c -> Printer.pr_constr (fst (run_delayed (Global.env()) Evd.empty c)))) names)
+
 let check_unused_names names =
   if not (List.is_empty names) && Flags.is_verbose () then
-    Feedback.msg_warning
-      (str"Unused introduction " ++ str (String.plural (List.length names) "pattern")
-       ++ str": " ++ prlist_with_sep spc 
-	 (Miscprint.pr_intro_pattern 
-	    (fun c -> Printer.pr_constr (fst (run_delayed (Global.env()) Evd.empty c)))) names)
+    warn_unused_intro_pattern names
 
 let intropattern_of_name gl avoid = function
   | Anonymous -> IntroNaming IntroAnonymous
@@ -2975,19 +3041,19 @@ let re_intro_dependent_hypotheses (lstatus,rstatus) (_,tophyp) =
     (intros_move rstatus)
     (intros_move newlstatus)
 
-let dest_intro_patterns avoid thin dest pat tac =
-  intro_patterns_core true avoid [] thin dest None 0 tac pat
+let dest_intro_patterns with_evars avoid thin dest pat tac =
+  intro_patterns_core with_evars true avoid [] thin dest None 0 tac pat
 
-let safe_dest_intro_patterns avoid thin dest pat tac =
+let safe_dest_intro_patterns with_evars avoid thin dest pat tac =
   Proofview.tclORELSE
-    (dest_intro_patterns avoid thin dest pat tac)
+    (dest_intro_patterns with_evars avoid thin dest pat tac)
     begin function (e, info) -> match e with
-      | UserError ("move_hyp",_) ->
+      | UserError (Some "move_hyp",_) ->
        (* May happen e.g. with "destruct x using s" with an hypothesis
           which is morally an induction hypothesis to be "MoveLast" if
           known as such but which is considered instead as a subterm of
           a constructor to be move at the place of x. *)
-          dest_intro_patterns avoid thin MoveLast pat tac
+          dest_intro_patterns with_evars avoid thin MoveLast pat tac
       | e -> Proofview.tclZERO ~info e
     end
 
@@ -3019,7 +3085,7 @@ let get_recarg_dest (recargdests,tophyp) =
    had to be introduced at the top of the context).
 *)
 
-let induct_discharge dests avoid' tac (avoid,ra) names =
+let induct_discharge with_evars dests avoid' tac (avoid,ra) names =
   let avoid = avoid @ avoid' in
   let rec peel_tac ra dests names thin =
     match ra with
@@ -3032,12 +3098,12 @@ let induct_discharge dests avoid' tac (avoid,ra) names =
 	      (pat, [dloc, IntroNaming (IntroIdentifier id')])
           | _ -> consume_pattern avoid (Name recvarname) deprec gl names in
         let dest = get_recarg_dest dests in
-        dest_intro_patterns avoid thin dest [recpat] (fun ids thin ->
+        dest_intro_patterns with_evars avoid thin dest [recpat] (fun ids thin ->
         Proofview.Goal.enter { enter = begin fun gl ->
           let (hyprec,names) =
             consume_pattern avoid (Name hyprecname) depind gl names
           in
-	  dest_intro_patterns avoid thin MoveLast [hyprec] (fun ids' thin ->
+	  dest_intro_patterns with_evars avoid thin MoveLast [hyprec] (fun ids' thin ->
 	    peel_tac ra' (update_dest dests ids') names thin)
         end })
         end }
@@ -3046,7 +3112,7 @@ let induct_discharge dests avoid' tac (avoid,ra) names =
 	(* Rem: does not happen in Coq schemes, only in user-defined schemes *)
         let pat,names =
           consume_pattern avoid (Name hyprecname) dep gl names in
-	dest_intro_patterns avoid thin MoveLast [pat] (fun ids thin ->
+	dest_intro_patterns with_evars avoid thin MoveLast [pat] (fun ids thin ->
         peel_tac ra' (update_dest dests ids) names thin)
         end }
     | (RecArg,_,dep,recvarname) :: ra' ->
@@ -3054,14 +3120,14 @@ let induct_discharge dests avoid' tac (avoid,ra) names =
         let (pat,names) =
           consume_pattern avoid (Name recvarname) dep gl names in
         let dest = get_recarg_dest dests in
-	dest_intro_patterns avoid thin dest [pat] (fun ids thin ->
+	dest_intro_patterns with_evars avoid thin dest [pat] (fun ids thin ->
         peel_tac ra' dests names thin)
         end }
     | (OtherArg,_,dep,_) :: ra' ->
         Proofview.Goal.enter { enter = begin fun gl ->
         let (pat,names) = consume_pattern avoid Anonymous dep gl names in
         let dest = get_recarg_dest dests in
-	safe_dest_intro_patterns avoid thin dest [pat] (fun ids thin ->
+	safe_dest_intro_patterns with_evars avoid thin dest [pat] (fun ids thin ->
         peel_tac ra' dests names thin)
         end }
     | [] ->
@@ -3209,7 +3275,6 @@ exception Shunt of Id.t move_location
 let cook_sign hyp0_opt inhyps indvars env =
   (* First phase from L to R: get [toclear], [decldep] and [statuslist]
      for the hypotheses before (= more ancient than) hyp0 (see above) *)
-  let open Context.Named.Declaration in
   let toclear = ref [] in
   let avoid = ref [] in
   let decldeps = ref [] in
@@ -3219,7 +3284,7 @@ let cook_sign hyp0_opt inhyps indvars env =
   let before = ref true in
   let maindep = ref false in
   let seek_deps env decl rhyp =
-    let hyp = get_id decl in
+    let hyp = NamedDecl.get_id decl in
     if (match hyp0_opt with Some hyp0 -> Id.equal hyp hyp0 | _ -> false)
     then begin
       before:=false;
@@ -3238,7 +3303,7 @@ let cook_sign hyp0_opt inhyps indvars env =
       in
       let depother = List.is_empty inhyps &&
 	(List.exists (fun id -> occur_var_in_decl env id decl) indvars ||
-         List.exists (fun decl' -> occur_var_in_decl env (get_id decl') decl) !decldeps)
+         List.exists (fun decl' -> occur_var_in_decl env (NamedDecl.get_id decl') decl) !decldeps)
       in
       if not (List.is_empty inhyps) && Id.List.mem hyp inhyps
          || dephyp0 || depother
@@ -3261,7 +3326,7 @@ let cook_sign hyp0_opt inhyps indvars env =
   let _ = fold_named_context seek_deps env ~init:MoveFirst in
   (* 2nd phase from R to L: get left hyp of [hyp0] and [lhyps] *)
   let compute_lstatus lhyp decl =
-    let hyp = get_id decl in
+    let hyp = NamedDecl.get_id decl in
     if (match hyp0_opt with Some hyp0 -> Id.equal hyp hyp0 | _ -> false) then
       raise (Shunt lhyp);
     if Id.List.mem hyp !ldeps then begin
@@ -3382,7 +3447,7 @@ let make_up_names n ind_opt cname =
 
 let error_ind_scheme s =
   let s = if not (String.is_empty s) then s^" " else s in
-  errorlabstrm "Tactics" (str "Cannot recognize " ++ str s ++ str "an induction scheme.")
+  user_err ~hdr:"Tactics" (str "Cannot recognize " ++ str s ++ str "an induction scheme.")
 
 let glob = Universes.constr_of_global
 
@@ -3429,8 +3494,8 @@ let ids_of_constr ?(all=false) vars c =
 	      Array.fold_left_from
 		(if all then 0 else mib.Declarations.mind_nparams)
 		aux vars args
-	| _ -> fold_constr aux vars c)
-    | _ -> fold_constr aux vars c
+	| _ -> Term.fold_constr aux vars c)
+    | _ -> Term.fold_constr aux vars c
   in aux vars c
 
 let decompose_indapp f args =
@@ -3485,13 +3550,12 @@ let make_abstract_generalize env id typ concl dep ctx body c eqs args refls =
   end }
 
 let hyps_of_vars env sign nogen hyps =
-  let open Context.Named.Declaration in
   if Id.Set.is_empty hyps then []
   else
     let (_,lh) =
       Context.Named.fold_inside
         (fun (hs,hl) d ->
-          let x = get_id d in
+          let x = NamedDecl.get_id d in
 	  if Id.Set.mem x nogen then (hs,hl)
 	  else if Id.Set.mem x hs then (hs,x::hl)
 	  else
@@ -3521,8 +3585,7 @@ let linear vars args =
     with Seen -> false
 
 let is_defined_variable env id =
-  let open Context.Named.Declaration in
-  lookup_named id env |> is_local_def
+  env |> lookup_named id |> is_local_def
 
 let abstract_args gl generalize_vars dep id defined f args =
   let open Context.Rel.Declaration in
@@ -3545,7 +3608,7 @@ let abstract_args gl generalize_vars dep id defined f args =
     let name, ty, arity =
       let rel, c = Reductionops.splay_prod_n env !sigma 1 prod in
       let decl = List.hd rel in
-      get_name decl, get_type decl, c
+      RelDecl.get_name decl, RelDecl.get_type decl, c
     in
     let argty = Tacmach.pf_unsafe_type_of gl arg in
     let sigma', ty = Evarsolve.refresh_universes (Some true) env !sigma ty in
@@ -3839,7 +3902,7 @@ let compute_elim_sig ?elimc elimt =
       | Some (LocalAssum (_,ind)) ->
 	  let indhd,indargs = decompose_app ind in
 	  try {!res with indref = Some (global_of_constr indhd) }
-	  with e when Errors.noncritical e ->
+	  with e when CErrors.noncritical e ->
             error "Cannot find the inductive type of the inductive scheme."
 
 let compute_scheme_signature scheme names_info ind_type_guess =
@@ -3980,14 +4043,15 @@ let is_functional_induction elimc gl =
    need a dependent one or not *)
 
 let get_eliminator elim dep s gl =
-  let open Context.Rel.Declaration in
   match elim with
   | ElimUsing (elim,indsign) ->
       Tacmach.New.project gl, (* bugged, should be computed *) true, elim, indsign
   | ElimOver (isrec,id) ->
       let evd, (elimc,elimt),_ as elims = guess_elim isrec dep s id gl in
       let _, (l, s) = compute_elim_signature elims id in
-      let branchlengthes = List.map (fun d -> assert (is_local_assum d); pi1 (decompose_prod_letin (get_type d))) (List.rev s.branches) in
+      let branchlengthes = List.map (fun d -> assert (RelDecl.is_local_assum d); pi1 (decompose_prod_letin (RelDecl.get_type d)))
+                                    (List.rev s.branches)
+      in
       evd, isrec, ({elimindex = None; elimbody = elimc; elimrename = Some (isrec,Array.of_list branchlengthes)}, elimt), l
 
 (* Instantiate all meta variables of elimclause using lid, some elts
@@ -4000,7 +4064,7 @@ let recolle_clenv i params args elimclause gl =
       (fun x ->
 	match kind_of_term x with
 	  | Meta mv -> mv
-	  | _  -> errorlabstrm "elimination_clause"
+	  | _  -> user_err ~hdr:"elimination_clause"
               (str "The type of the elimination clause is not well-formed."))
       arr in
   let k = match i with -1 -> Array.length lindmv - List.length args | _ -> i in
@@ -4048,8 +4112,7 @@ let induction_tac with_evars params indvars elim =
    hypotheses from the context, replacing the main hypothesis on which
    induction applies with the induction hypotheses *)
 
-let apply_induction_in_context hyp0 inhyps elim indvars names induct_tac =
-  let open Context.Named.Declaration in
+let apply_induction_in_context with_evars hyp0 inhyps elim indvars names induct_tac =
   Proofview.Goal.s_enter { s_enter = begin fun gl ->
     let sigma = Proofview.Goal.sigma gl in
     let env = Proofview.Goal.env gl in
@@ -4062,7 +4125,7 @@ let apply_induction_in_context hyp0 inhyps elim indvars names induct_tac =
     let s = Retyping.get_sort_family_of env sigma tmpcl in
     let deps_cstr =
       List.fold_left
-        (fun a decl -> if is_local_assum decl then (mkVar (get_id decl))::a else a) [] deps in
+        (fun a decl -> if NamedDecl.is_local_assum decl then (mkVar (NamedDecl.get_id decl))::a else a) [] deps in
     let (sigma, isrec, elim, indsign) = get_eliminator elim dep s (Proofview.Goal.assume gl) in
     let branchletsigns =
       let f (_,is_not_let,_,_) = is_not_let in
@@ -4078,7 +4141,8 @@ let apply_induction_in_context hyp0 inhyps elim indvars names induct_tac =
         Tacticals.New.tclMAP expand_hyp toclear;
       ])
       (Array.map2
-         (induct_discharge lhyp0 avoid (re_intro_dependent_hypotheses statuslists))
+         (induct_discharge with_evars lhyp0 avoid
+            (re_intro_dependent_hypotheses statuslists))
          indsign names)
     in
     Sigma.Unsafe.of_pair (tac, sigma)
@@ -4088,7 +4152,7 @@ let induction_with_atomization_of_ind_arg isrec with_evars elim names hyp0 inhyp
   Proofview.Goal.enter { enter = begin fun gl ->
   let elim_info = find_induction_type isrec elim hyp0 (Proofview.Goal.assume gl) in
   atomize_param_of_ind_then elim_info hyp0 (fun indvars ->
-    apply_induction_in_context (Some hyp0) inhyps (pi3 elim_info) indvars names
+    apply_induction_in_context with_evars (Some hyp0) inhyps (pi3 elim_info) indvars names
       (fun elim -> induction_tac with_evars [] [hyp0] elim))
   end }
 
@@ -4137,22 +4201,21 @@ let induction_without_atomization isrec with_evars elim names lid =
     induction_tac with_evars params realindvars elim;
   ] in
   let elim = ElimUsing (({elimindex = Some (-1); elimbody = Option.get scheme.elimc; elimrename = None}, scheme.elimt), indsign) in
-  apply_induction_in_context None [] elim indvars names induct_tac
+  apply_induction_in_context with_evars None [] elim indvars names induct_tac
   end }
 
 (* assume that no occurrences are selected *)
 let clear_unselected_context id inhyps cls =
   Proofview.Goal.nf_enter { enter = begin fun gl ->
-  let open Context.Named.Declaration in
   if occur_var (Tacmach.New.pf_env gl) id (Tacmach.New.pf_concl gl) &&
     cls.concl_occs == NoOccurrences
-  then errorlabstrm ""
+  then user_err 
     (str "Conclusion must be mentioned: it depends on " ++ pr_id id
      ++ str ".");
   match cls.onhyps with
   | Some hyps ->
       let to_erase d =
-        let id' = get_id d in
+        let id' = NamedDecl.get_id d in
 	if Id.List.mem id' inhyps then (* if selected, do not erase *) None
 	else
 	  (* erase if not selected and dependent on id or selected hyps *)
@@ -4211,7 +4274,7 @@ let check_enough_applied env sigma elim =
   | None ->
       (* No eliminator given *)
       fun u ->
-      let t,_ = decompose_app (whd_betadeltaiota env sigma u) in isInd t
+      let t,_ = decompose_app (whd_all env sigma u) in isInd t
   | Some elimc ->
       let elimt = Retyping.get_type_of env sigma (fst elimc) in
       let scheme = compute_elim_sig ~elimc elimt in
@@ -4305,7 +4368,7 @@ let induction_gen clear_flag isrec with_evars elim
   let cls = Option.default allHypsAndConcl cls in
   let t = typ_of env sigma c in
   let is_arg_pure_hyp =
-    isVar c && not (mem_named_context (destVar c) (Global.named_context()))
+    isVar c && not (mem_named_context_val (destVar c) (Global.named_context_val ()))
     && lbind == NoBindings && not with_evars && Option.is_empty eqname
     && clear_flag == None
     && has_generic_occurrences_but_goal cls (destVar c) env ccl in
@@ -4345,14 +4408,14 @@ let induction_gen_l isrec with_evars elim names lc =
   let lc = List.map (function
     | (c,None) -> c
     | (c,Some(loc,eqname)) ->
-      user_err_loc (loc,"",str "Do not know what to do with " ++
+      user_err ~loc  (str "Do not know what to do with " ++
                          Miscprint.pr_intro_pattern_naming eqname)) lc in
   let rec atomize_list l =
     match l with
       | [] -> Proofview.tclUNIT ()
       | c::l' ->
 	  match kind_of_term c with
-	    | Var id when not (mem_named_context id (Global.named_context()))
+	    | Var id when not (mem_named_context_val id (Global.named_context_val ()))
 		&& not with_evars ->
 		let _ = newlc:= id::!newlc in
 		atomize_list l'
@@ -4394,19 +4457,11 @@ let induction_destruct isrec with_evars (lc,elim) =
       (* Standard induction on non-standard induction schemes *)
       (* will be removable when is_functional_induction will be more clever *)
       if not (Option.is_empty cls) then error "'in' clause not supported here.";
-      let finish_evar_resolution f =
-        let ((c, lbind), sigma') = run_delayed env sigma f in
-        let pending = (sigma,sigma') in
-        let sigma' = Sigma.Unsafe.of_evar_map sigma' in
-        let Sigma (c, _, _) = finish_evar_resolution env sigma' (pending,c) in
-        (c, lbind)
-      in
-      let c = map_induction_arg finish_evar_resolution c in
+      let _,c = force_destruction_arg false env sigma c in
       onInductionArg
-	(fun _clear_flag (c,lbind) ->
-	  if lbind != NoBindings then
-	    error "'with' clause not supported here.";
-	  induction_gen_l isrec with_evars elim names [c,eqname]) c
+	(fun _clear_flag c ->
+	  induction_gen_l isrec with_evars elim names
+            [with_no_bindings c,eqname]) c
     | _ ->
       (* standard induction *)
       onOpenInductionArg env sigma
@@ -4437,23 +4492,14 @@ let induction_destruct isrec with_evars (lc,elim) =
           end }) l)
     | Some elim ->
       (* Several induction hyps with induction scheme *)
-      let finish_evar_resolution f =
-        let ((c, lbind), sigma') = run_delayed env sigma f in
-        let pending = (sigma,sigma') in
-	if lbind != NoBindings then
-	  error "'with' clause not supported here.";
-	let sigma' = Sigma.Unsafe.of_evar_map sigma' in
-        let Sigma (c, _, _) = finish_evar_resolution env sigma' (pending,c) in
-        c
-      in
-      let lc = List.map (on_pi1 (map_induction_arg finish_evar_resolution)) lc in
+      let lc = List.map (on_pi1 (fun c -> snd (force_destruction_arg false env sigma c))) lc in
       let newlc =
         List.map (fun (x,(eqn,names),cls) ->
           if cls != None then error "'in' clause not yet supported here.";
 	  match x with (* FIXME: should we deal with ElimOnIdent? *)
           | _clear_flag,ElimOnConstr x ->
               if eqn <> None then error "'eqn' clause not supported here.";
-              (x,names)
+              (with_no_bindings x,names)
 	  | _ -> error "Don't know where to find some argument.")
 	  lc in
       (* Check that "as", if any, is given only on the last argument *)
@@ -4548,7 +4594,7 @@ let maybe_betadeltaiota_concl allowred gl =
   if not allowred then concl
   else
     let env = Proofview.Goal.env gl in
-    whd_betadeltaiota env sigma concl
+    whd_all env sigma concl
 
 let reflexivity_red allowred =
   Proofview.Goal.enter { enter = begin fun gl ->
@@ -4736,7 +4782,7 @@ let interpretable_as_section_decl evd d1 d2 =
   | LocalDef _, LocalAssum _ -> false
   | LocalDef (_,b1,t1), LocalDef (_,b2,t2) ->
     e_eq_constr_univs evd b1 b2 && e_eq_constr_univs evd t1 t2
-  | LocalAssum (_,t1), d2 -> e_eq_constr_univs evd t1 (get_type d2)
+  | LocalAssum (_,t1), d2 -> e_eq_constr_univs evd t1 (NamedDecl.get_type d2)
 
 let rec decompose len c t accu =
   let open Context.Rel.Declaration in
@@ -4749,20 +4795,19 @@ let rec decompose len c t accu =
   | _ -> assert false
 
 let rec shrink ctx sign c t accu =
-  let open Context.Rel.Declaration in
   match ctx, sign with
   | [], [] -> (c, t, accu)
   | p :: ctx, decl :: sign ->
-      if noccurn 1 c then
+      if noccurn 1 c && noccurn 1 t then
         let c = subst1 mkProp c in
         let t = subst1 mkProp t in
         shrink ctx sign c t accu
       else
         let c = mkLambda_or_LetIn p c in
         let t = mkProd_or_LetIn p t in
-        let accu = if is_local_assum p then let open Context.Named.Declaration in
-                                            mkVar (get_id decl) :: accu
-                                       else accu
+        let accu = if RelDecl.is_local_assum p
+                   then mkVar (NamedDecl.get_id decl) :: accu
+                   else accu
     in
     shrink ctx sign c t accu
 | _ -> assert false
@@ -4788,19 +4833,18 @@ let abstract_subproof id gk tac =
   let open Tacticals.New in
   let open Tacmach.New in
   let open Proofview.Notations in
-  let open Context.Named.Declaration in
   Proofview.Goal.nf_s_enter { s_enter = begin fun gl ->
   let sigma = Proofview.Goal.sigma gl in
-  let current_sign = Global.named_context()
+  let current_sign = Global.named_context_val ()
   and global_sign = Proofview.Goal.hyps gl in
   let sigma = Sigma.to_evar_map sigma in
   let evdref = ref sigma in
   let sign,secsign =
     List.fold_right
       (fun d (s1,s2) ->
-        let id = get_id d in
-	if mem_named_context id current_sign &&
-          interpretable_as_section_decl evdref (Context.Named.lookup id current_sign) d
+        let id = NamedDecl.get_id d in
+	if mem_named_context_val id current_sign &&
+          interpretable_as_section_decl evdref (lookup_named_val id current_sign) d
         then (s1,push_named_context_val d s2)
 	else (Context.Named.add d s1,s2))
       global_sign (Context.Named.empty, empty_named_context_val) in
@@ -4826,7 +4870,7 @@ let abstract_subproof id gk tac =
        which is an error irrelevant to the proof system (in fact it
        means that [e] comes from [tac] failing to yield enough
        success). Hence it reraises [e]. *)
-    let (_, info) = Errors.push src in
+    let (_, info) = CErrors.push src in
     iraise (e, info)
   in
   let const, args =
@@ -4835,8 +4879,13 @@ let abstract_subproof id gk tac =
   in
   let cd = Entries.DefinitionEntry const in
   let decl = (cd, IsProof Lemma) in
-  (** ppedrot: seems legit to have abstracted subproofs as local*)
-  let cst = Declare.declare_constant ~internal:Declare.InternalTacticRequest ~local:true id decl in
+  let cst () =
+    (** do not compute the implicit arguments, it may be costly *)
+    let () = Impargs.make_implicit_args false in
+    (** ppedrot: seems legit to have abstracted subproofs as local*)
+    Declare.declare_constant ~internal:Declare.InternalTacticRequest ~local:true id decl
+  in
+  let cst = Impargs.with_implicit_protection cst () in
   (* let evd, lem = Evd.fresh_global (Global.env ()) evd (ConstRef cst) in *)
   let lem, ctx = Universes.unsafe_constr_of_global (ConstRef cst) in
   let evd = Evd.set_universe_context evd ectx in
@@ -4886,7 +4935,7 @@ let unify ?(state=full_transparent_state) x y =
     let sigma = Sigma.to_evar_map sigma in
     let sigma = w_unify (Tacmach.New.pf_env gl) sigma Reduction.CONV ~flags x y in
     Sigma.Unsafe.of_pair (Proofview.tclUNIT (), sigma)
-  with e when Errors.noncritical e ->
+  with e when CErrors.noncritical e ->
     Sigma.here (Tacticals.New.tclFAIL 0 (str"Not unifiable")) sigma
   end }
 
@@ -4918,9 +4967,16 @@ module New = struct
   open Locus
 
   let reduce_after_refine =
+    let onhyps =
+      (** We reduced everywhere in the hyps before 8.6 *)
+      if Flags.version_compare !Flags.compat_version Flags.V8_5 == 0
+      then None
+      else Some []
+    in
     reduce
-      (Lazy {rBeta=true;rIota=true;rZeta=false;rDelta=false;rConst=[]})
-      {onhyps=None; concl_occs=AllOccurrences }
+      (Lazy {rBeta=true;rMatch=true;rFix=true;rCofix=true;
+	     rZeta=false;rDelta=false;rConst=[]})
+      {onhyps; concl_occs=AllOccurrences }
 
   let refine ?unsafe c =
     Refine.refine ?unsafe c <*>
diff --git a/tactics/tactics.mli b/tactics/tactics.mli
index df41951c3..7acfb6286 100644
--- a/tactics/tactics.mli
+++ b/tactics/tactics.mli
@@ -15,13 +15,16 @@ open Evd
 open Clenv
 open Redexpr
 open Globnames
-open Tacexpr
 open Pattern
 open Unification
 open Misctypes
+open Tactypes
 open Locus
 
-(** Main tactics. *)
+(** Main tactics defined in ML. This file is huge and should probably be split
+    in more reasonable units at some point. Because of its size and age, the
+    implementation features various styles and stages of the proof engine.
+    This has to be uniformized someday. *)
 
 (** {6 General functions. } *)
 
@@ -91,7 +94,11 @@ val try_intros_until :
 
 val onInductionArg :
   (clear_flag -> constr with_bindings -> unit Proofview.tactic) ->
-    constr with_bindings induction_arg -> unit Proofview.tactic
+    constr with_bindings destruction_arg -> unit Proofview.tactic
+
+val force_destruction_arg : evars_flag -> env -> evar_map ->
+    delayed_open_constr_with_bindings destruction_arg ->
+    evar_map * constr with_bindings destruction_arg
 
 (** Tell if a used hypothesis should be cleared by default or not *)
 
@@ -99,16 +106,16 @@ val use_clear_hyp_by_default : unit -> bool
 
 (** {6 Introduction tactics with eliminations. } *)
 
-val intro_patterns : intro_patterns -> unit Proofview.tactic
-val intro_patterns_to : Id.t move_location -> intro_patterns ->
+val intro_patterns : evars_flag -> intro_patterns -> unit Proofview.tactic
+val intro_patterns_to : evars_flag -> Id.t move_location -> intro_patterns ->
   unit Proofview.tactic
-val intro_patterns_bound_to : int -> Id.t move_location -> intro_patterns ->
+val intro_patterns_bound_to : evars_flag -> int -> Id.t move_location -> intro_patterns ->
   unit Proofview.tactic
-val intro_pattern_to : Id.t move_location -> delayed_open_constr intro_pattern_expr ->
+val intro_pattern_to : evars_flag -> Id.t move_location -> delayed_open_constr intro_pattern_expr ->
   unit Proofview.tactic
 
 (** Implements user-level "intros", with [] standing for "**" *)
-val intros_patterns : intro_patterns -> unit Proofview.tactic
+val intros_patterns : evars_flag -> intro_patterns -> unit Proofview.tactic
 
 (** {6 Exact tactics. } *)
 
@@ -167,7 +174,7 @@ val unfold_body   : Id.t -> unit Proofview.tactic
 val keep          : Id.t list -> unit Proofview.tactic
 val apply_clear_request : clear_flag -> bool -> constr -> unit Proofview.tactic
 
-val specialize    : constr with_bindings -> unit Proofview.tactic
+val specialize    : constr with_bindings -> intro_pattern option -> unit Proofview.tactic
 
 val move_hyp      : Id.t -> Id.t move_location -> unit Proofview.tactic
 val rename_hyp    : (Id.t * Id.t) list -> unit Proofview.tactic
@@ -292,7 +299,7 @@ val destruct : evars_flag -> clear_flag -> constr -> or_and_intro_pattern option
 (** Implements user-level "destruct" and "induction" *)
 
 val induction_destruct : rec_flag -> evars_flag ->
-  (delayed_open_constr_with_bindings induction_arg
+  (delayed_open_constr_with_bindings destruction_arg
    * (intro_pattern_naming option * or_and_intro_pattern option)
    * clause option) list *
   constr with_bindings option -> unit Proofview.tactic
@@ -363,7 +370,7 @@ val pose_proof : Name.t -> constr ->
 
 (** Common entry point for user-level "assert", "enough" and "pose proof" *)
 
-val forward   : bool -> unit Proofview.tactic option ->
+val forward   : bool -> unit Proofview.tactic option option ->
   intro_pattern option -> constr -> unit Proofview.tactic
 
 (** Implements the tactic cut, actually a modus ponens rule *)
diff --git a/tactics/tactics.mllib b/tactics/tactics.mllib
index 48722f655..f54ad86a3 100644
--- a/tactics/tactics.mllib
+++ b/tactics/tactics.mllib
@@ -12,12 +12,10 @@ Equality
 Contradiction
 Inv
 Leminv
-Taccoerce
 Hints
 Auto
 Eauto
 Class_tactics
-Tactic_matching
 Term_dnet
 Eqdecide
 Autorewrite
diff --git a/test-suite/.csdp.cache b/test-suite/.csdp.cache
new file mode 100644
index 000000000..ba85286dd
--- /dev/null
+++ b/test-suite/.csdp.cache
diff --git a/test-suite/Makefile b/test-suite/Makefile
index 91b8a4ed0..c10cd4ed4 100644
--- a/test-suite/Makefile
+++ b/test-suite/Makefile
@@ -49,6 +49,10 @@ SINGLE_QUOTE="
 #" # double up on the quotes, in a comment, to appease the emacs syntax highlighter
 # wrap the arguments in parens, but only if they exist
 get_coq_prog_args_in_parens = $(subst $(SINGLE_QUOTE),,$(if $(call get_coq_prog_args,$(1)), ($(call get_coq_prog_args,$(1)))))
+# get the command to use with this set of arguments; if there's -compile, use coqc, else use coqtop
+has_compile_flag = $(filter "-compile",$(call get_coq_prog_args,$(1)))
+has_profile_ltac_or_compile_flag = $(filter "-profile-ltac-cutoff" "-profile-ltac" "-compile",$(call get_coq_prog_args,$(1)))
+get_command_based_on_flags = $(if $(call has_profile_ltac_or_compile_flag,$(1)),$(coqc),$(command))
 
 
 bogomips:=
@@ -79,11 +83,14 @@ COMPLEXITY := $(if $(bogomips),complexity)
 BUGS := bugs/opened bugs/closed
 
 VSUBSYSTEMS := prerequisite success failure $(BUGS) output \
-  interactive micromega $(COMPLEXITY) modules stm
+  output-modulo-time interactive micromega $(COMPLEXITY) modules stm
 
 # All subsystems
 SUBSYSTEMS := $(VSUBSYSTEMS) misc bugs ide vio coqchk
 
+PREREQUISITELOG = prerequisite/admit.v.log			\
+  prerequisite/make_local.v.log prerequisite/make_notation.v.log
+
 #######################################################################
 # Phony targets
 #######################################################################
@@ -98,7 +105,7 @@ run: $(SUBSYSTEMS)
 bugs: $(BUGS)
 
 clean:
-	rm -f trace lia.cache
+	rm -f trace .lia.cache
 	$(SHOW) "RM        <**/*.stamp> <**/*.vo> <**/*.vio> <**/*.log>"
 	$(HIDE)find . \( \
 	  -name '*.stamp' -o -name '*.vo' -o -name '*.vio' -o -name '*.log' \
@@ -133,6 +140,7 @@ summary:
 	  $(call summary_dir, "Failure tests", failure); \
 	  $(call summary_dir, "Bugs tests", bugs); \
 	  $(call summary_dir, "Output tests", output); \
+	  $(call summary_dir, "Output (modulo time changes) tests", output-modulo-time); \
 	  $(call summary_dir, "Interactive tests", interactive); \
 	  $(call summary_dir, "Micromega tests", micromega); \
 	  $(call summary_dir, "Miscellaneous tests", misc); \
@@ -172,7 +180,7 @@ $(addsuffix .log,$(wildcard bugs/opened/*.v)): %.v.log: %.v
 	@echo "TEST      $<  $(call get_coq_prog_args_in_parens,"$<")"
 	$(HIDE){ \
 	  echo $(call log_intro,$<); \
-	  $(command) "$<" $(call get_coq_prog_args,"$<") 2>&1; R=$$?; times; \
+	  $(call get_command_based_on_flags,"$<") "$<" $(call get_coq_prog_args,"$<") 2>&1; R=$$?; times; \
 	  if [ $$R = 0 ]; then \
 	    echo $(log_success); \
 	    echo "    $<...still active"; \
@@ -193,7 +201,7 @@ $(addsuffix .log,$(wildcard bugs/closed/*.v)): %.v.log: %.v
 	@echo "TEST      $< $(call get_coq_prog_args_in_parens,"$<")"
 	$(HIDE){ \
 	  echo $(call log_intro,$<); \
-	  $(command) "$<" $(call get_coq_prog_args,"$<") 2>&1; R=$$?; times; \
+	  $(call get_command_based_on_flags,"$<") "$<" $(call get_coq_prog_args,"$<") 2>&1; R=$$?; times; \
 	  if [ $$R = 0 ]; then \
 	    echo $(log_success); \
 	    echo "    $<...Ok"; \
@@ -221,12 +229,12 @@ $(addsuffix .log,$(wildcard prerequisite/*.v)): %.v.log: %.v
 	  fi; \
 	} > "$@"
 
-$(addsuffix .log,$(wildcard success/*.v micromega/*.v modules/*.v)): %.v.log: %.v
+$(addsuffix .log,$(wildcard success/*.v micromega/*.v modules/*.v)): %.v.log: %.v $(PREREQUISITELOG)
 	@echo "TEST      $< $(call get_coq_prog_args_in_parens,"$<")"
 	$(HIDE){ \
 	  opts="$(if $(findstring modules/,$<),-R modules Mods -impredicative-set)"; \
 	  echo $(call log_intro,$<); \
-	  $(command) "$<" $(call get_coq_prog_args,"$<") $$opts 2>&1; R=$$?; times; \
+	  $(call get_command_based_on_flags,"$<") "$<" $(call get_coq_prog_args,"$<") $$opts 2>&1; R=$$?; times; \
 	  if [ $$R = 0 ]; then \
 	    echo $(log_success); \
 	    echo "    $<...Ok"; \
@@ -252,11 +260,11 @@ $(addsuffix .log,$(wildcard stm/*.v)): %.v.log: %.v
 	  fi; \
 	} > "$@"
 
-$(addsuffix .log,$(wildcard failure/*.v)): %.v.log: %.v
+$(addsuffix .log,$(wildcard failure/*.v)): %.v.log: %.v $(PREREQUISITELOG)
 	@echo "TEST      $< $(call get_coq_prog_args_in_parens,"$<")"
 	$(HIDE){ \
 	  echo $(call log_intro,$<); \
-	  $(command) "$<" $(call get_coq_prog_args,"$<") 2>&1; R=$$?; times; \
+	  $(call get_command_based_on_flags,"$<") "$<" $(call get_coq_prog_args,"$<") 2>&1; R=$$?; times; \
 	  if [ $$R = 0 ]; then \
 	    echo $(log_success); \
 	    echo "    $<...Ok"; \
@@ -266,16 +274,17 @@ $(addsuffix .log,$(wildcard failure/*.v)): %.v.log: %.v
 	  fi; \
 	} > "$@"
 
-$(addsuffix .log,$(wildcard output/*.v)): %.v.log: %.v %.out
+$(addsuffix .log,$(wildcard output/*.v)): %.v.log: %.v %.out $(PREREQUISITELOG)
 	@echo "TEST      $< $(call get_coq_prog_args_in_parens,"$<")"
 	$(HIDE){ \
 	  echo $(call log_intro,$<); \
 	  tmpoutput=`mktemp /tmp/coqcheck.XXXXXX`; \
-	  $(command) "$<" $(call get_coq_prog_args,"$<") 2>&1 \
+	  $(call get_command_based_on_flags,"$<") "$<" $(call get_coq_prog_args,"$<") 2>&1 \
 	    | grep -v "Welcome to Coq" \
 	    | grep -v "\[Loading ML file" \
 	    | grep -v "Skipping rcfile loading" \
 	    | grep -v "^<W>" \
+	    | sed 's/File "[^"]*"/File "stdin"/' \
 	    > $$tmpoutput; \
 	  diff -u $*.out $$tmpoutput 2>&1; R=$$?; times; \
 	  if [ $$R = 0 ]; then \
@@ -288,7 +297,43 @@ $(addsuffix .log,$(wildcard output/*.v)): %.v.log: %.v %.out
 	  rm $$tmpoutput; \
 	} > "$@"
 
-$(addsuffix .log,$(wildcard interactive/*.v)): %.v.log: %.v
+$(addsuffix .log,$(wildcard output-modulo-time/*.v)): %.v.log: %.v %.out
+	@echo "TEST      $< $(call get_coq_prog_args_in_parens,"$<")"
+	$(HIDE){ \
+	  echo $(call log_intro,$<); \
+	  tmpoutput=`mktemp /tmp/coqcheck.XXXXXX`; \
+	  tmpexpected=`mktemp /tmp/coqcheck.XXXXXX`; \
+	  $(call get_command_based_on_flags,"$<") "$<" $(call get_coq_prog_args,"$<") 2>&1 \
+	    | grep -v "Welcome to Coq" \
+	    | grep -v "\[Loading ML file" \
+	    | grep -v "Skipping rcfile loading" \
+	    | grep -v "^<W>" \
+	    | sed -e 's/\s*[-+0-9]*\.[0-9][0-9]*\s*//g' \
+	          -e 's/\s*0\.\s*//g' \
+		  -e 's/\s*[-+]nan\s*//g' \
+		  -e 's/\s*[-+]inf\s*//g' \
+		  -e 's/^[^a-zA-Z]*//' \
+	    | sort \
+	    > $$tmpoutput; \
+	  sed -e 's/\s*[-+0-9]*\.[0-9][0-9]*\s*//g' \
+		-e 's/\s*0\.\s*//g' \
+		-e 's/\s*[-+]nan\s*//g' \
+		-e 's/\s*[-+]inf\s*//g' \
+		-e 's/^[^a-zA-Z]*//' \
+	       $*.out | sort > $$tmpexpected; \
+	  diff -b -u $$tmpexpected $$tmpoutput 2>&1; R=$$?; times; \
+	  if [ $$R = 0 ]; then \
+	    echo $(log_success); \
+	    echo "    $<...Ok"; \
+	  else \
+	    echo $(log_failure); \
+	    echo "    $<...Error! (unexpected output)"; \
+	  fi; \
+	  rm $$tmpoutput; \
+	  rm $$tmpexpected; \
+	} > "$@"
+
+$(addsuffix .log,$(wildcard interactive/*.v)): %.v.log: %.v $(PREREQUISITELOG)
 	@echo "TEST      $< $(call get_coq_prog_args_in_parens,"$<")"
 	$(HIDE){ \
 	  echo $(call log_intro,$<); \
@@ -306,12 +351,12 @@ $(addsuffix .log,$(wildcard interactive/*.v)): %.v.log: %.v
 # the .v file with exactly two digits after the dot. The reference for
 # time is a 6120 bogomips cpu.
 ifneq (,$(bogomips))
-$(addsuffix .log,$(wildcard complexity/*.v)): %.v.log: %.v
+$(addsuffix .log,$(wildcard complexity/*.v)): %.v.log: %.v $(PREREQUISITELOG)
 	@echo "TEST      $< $(call get_coq_prog_args_in_parens,"$<")"
 	$(HIDE){ \
 	  echo $(call log_intro,$<); \
 	  true "extract effective user time"; \
-	  res=`$(command) "$<" $(call get_coq_prog_args,"$<") 2>&1 | sed -n -e "s/Finished transaction in .*(\([0-9]*\.[0-9]*\)u.*)/\1/p" | head -1`; \
+	  res=`$(call get_command_based_on_flags,"$<") "$<" $(call get_coq_prog_args,"$<") 2>&1 | sed -n -e "s/Finished transaction in .*(\([0-9]*\.[0-9]*\)u.*)/\1/p" | head -1`; \
 	  R=$$?; times; \
 	  if [ $$R != 0 ]; then \
 	    echo $(log_failure); \
@@ -337,11 +382,11 @@ $(addsuffix .log,$(wildcard complexity/*.v)): %.v.log: %.v
 endif
 
 # Ideal-features tests
-$(addsuffix .log,$(wildcard ideal-features/*.v)): %.v.log: %.v
+$(addsuffix .log,$(wildcard ideal-features/*.v)): %.v.log: %.v $(PREREQUISITELOG)
 	@echo "TEST      $< $(call get_coq_prog_args_in_parens,"$<")"
 	$(HIDE){ \
 	  echo $(call log_intro,$<); \
-	  $(command) "$<" $(call get_coq_prog_args,"$<") 2>&1; R=$$?; times; \
+	  $(call get_command_based_on_flags,"$<") "$<" $(call get_coq_prog_args,"$<") 2>&1; R=$$?; times; \
 	  if [ $$R != 0 ]; then \
 	      echo $(log_success); \
 	      echo "    $<...still wished"; \
@@ -360,7 +405,7 @@ modules/%.vo: modules/%.v
 # Miscellaneous tests
 #######################################################################
 
-misc: misc/deps-order.log misc/universes.log
+misc: misc/deps-order.log misc/universes.log misc/deps-checksum.log
 
 # Check that both coqdep and coqtop/coqc supports -R
 # Check that both coqdep and coqtop/coqc takes the later -R
@@ -389,6 +434,26 @@ misc/deps-order.log:
 	  rm $$tmpoutput; \
 	} > "$@"
 
+deps-checksum: misc/deps-checksum.log
+misc/deps-checksum.log:
+	@echo "TEST      misc/deps-checksum"
+	$(HIDE){ \
+	  echo $(call log_intro,deps-checksum); \
+	  rm -f misc/deps/*/*.vo; \
+	  $(bincoqc) -R misc/deps/A A misc/deps/A/A.v; \
+	  $(bincoqc) -R misc/deps/B A misc/deps/B/A.v; \
+	  $(bincoqc) -R misc/deps/B A misc/deps/B/B.v; \
+	  $(coqtop) -R misc/deps/B A -R misc/deps/A A -load-vernac-source misc/deps/checksum.v 2>&1; \
+	  if [ $$? = 0 ]; then \
+	    echo $(log_success); \
+	    echo "    misc/deps-checksum...Ok"; \
+	  else \
+	    echo $(log_failure); \
+	    echo "    misc/deps-checksum...Error!"; \
+	  fi; \
+	} > "$@"
+
+
 # Sort universes for the whole standard library
 EXPECTED_UNIVERSES := 4 # Prop is not counted
 universes: misc/universes.log
@@ -421,7 +486,7 @@ ide : $(patsubst %.fake,%.fake.log,$(wildcard ide/*.fake))
 	@echo "TEST      $<"
 	$(HIDE){ \
 	  echo $(call log_intro,$<); \
-	  $(BIN)fake_ide $< "$(BIN)coqtop -boot -async-proofs on" 2>&1; \
+	  $(BIN)fake_ide $< "$(BIN)coqtop -boot -async-proofs on -async-proofs-tactic-error-resilience off -async-proofs-command-error-resilience off" 2>&1; \
 	  if [ $$? = 0 ]; then \
 	    echo $(log_success); \
 	    echo "    $<...Ok"; \
@@ -463,4 +528,3 @@ coqchk: $(patsubst %.v,%.chk.log,$(wildcard coqchk/*.v))
 	    echo "    $<...Error!"; \
 	  fi; \
 	} > "$@"
-
diff --git a/test-suite/bugs/closed/1784.v b/test-suite/bugs/closed/1784.v
index 0b63d7b56..25d1b192e 100644
--- a/test-suite/bugs/closed/1784.v
+++ b/test-suite/bugs/closed/1784.v
@@ -91,9 +91,8 @@ Next Obligation. intro H; inversion H. Defined.
 Next Obligation. intro H; inversion H; subst. Defined.
 Next Obligation.
   intro H1; contradict H. inversion H1; subst. assumption.
-  contradict H0; assumption. Defined.
-Next Obligation. 
-  intro H1; contradict H0. inversion H1; subst. assumption. Defined.
+  contradict H0; assumption.  Defined.
+Next Obligation. intro H1; contradict H0. inversion H1; subst. assumption. Defined.
 Next Obligation.
   intro H1; contradict H. inversion H1; subst. assumption. Defined.
 Next Obligation.
diff --git a/test-suite/bugs/closed/2016.v b/test-suite/bugs/closed/2016.v
index 13ec5bea9..536e6fabd 100644
--- a/test-suite/bugs/closed/2016.v
+++ b/test-suite/bugs/closed/2016.v
@@ -1,6 +1,8 @@
 (* Coq 8.2beta4 *)
 Require Import Classical_Prop. 
 
+Unset Structural Injection.
+
 Record coreSemantics : Type := CoreSemantics {
   core: Type;
   corestep: core ->  core -> Prop;
@@ -49,7 +51,7 @@ unfold oe_corestep; intros.
 assert (HH:= step_fun _ _ _ H H0); clear H H0.
 destruct q1; destruct q2; unfold oe2coreSem; simpl in *.
 generalize (inj_pairT1 _ _ _ _ _ _ HH); clear HH; intros.
-injection H; clear H; intros.
+injection H.
 revert in_q1  in_corestep1 in_corestep_fun1
           H.
 pattern in_core1.
@@ -59,4 +61,4 @@ apply sym_eq.
 (** good to here **)
 Show Universes.
 Print Universes.
-Fail apply H0.
\ No newline at end of file
+Fail apply H0.
diff --git a/test-suite/bugs/closed/2021.v b/test-suite/bugs/closed/2021.v
index e598e5aed..5df92998e 100644
--- a/test-suite/bugs/closed/2021.v
+++ b/test-suite/bugs/closed/2021.v
@@ -1,6 +1,8 @@
 (* correct failure of injection/discriminate on types whose inductive
    status derives from the substitution of an argument *)
 
+Unset Structural Injection.
+
 Inductive t : nat -> Type :=
 | M : forall n: nat, nat -> t n.
 
diff --git a/test-suite/bugs/closed/2310.v b/test-suite/bugs/closed/2310.v
index 0be859edd..7fae32871 100644
--- a/test-suite/bugs/closed/2310.v
+++ b/test-suite/bugs/closed/2310.v
@@ -14,4 +14,8 @@ Definition replace a (y:Nest (prod a a)) : a = a -> Nest a.
    (P:=\a.Nest (prod a a) and P:=\_.Nest (prod a a)) and refine should either
    leave P as subgoal or choose itself one solution *)
 
-intros. refine (Cons (cast H _ y)).
\ No newline at end of file
+  intros. Fail refine (Cons (cast H _ y)).
+  Unset Solve Unification Constraints. (* Keep the unification constraint around *)
+  refine (Cons (cast H _ y)).
+  intros.
+  refine (Nest (prod X X)). Qed.
\ No newline at end of file
diff --git a/test-suite/bugs/closed/2839.v b/test-suite/bugs/closed/2839.v
index e396fe06e..e727e2606 100644
--- a/test-suite/bugs/closed/2839.v
+++ b/test-suite/bugs/closed/2839.v
@@ -5,6 +5,6 @@ intro.
 Fail
   let H :=
     match goal with
-    | [ H : appcontext G [@eq _ _] |- _ ] => let H' := context G[@plus 2] in H'
+    | [ H : context G [@eq _ _] |- _ ] => let H' := context G[@plus 2] in H'
     end
   in pose H.
diff --git a/test-suite/bugs/closed/3045.v b/test-suite/bugs/closed/3045.v
index ef110ad0d..5f80013df 100644
--- a/test-suite/bugs/closed/3045.v
+++ b/test-suite/bugs/closed/3045.v
@@ -12,7 +12,7 @@ Record SpecializedCategory (obj : Type) :=
     Compose : forall s d d', Morphism d d' -> Morphism s d -> Morphism s d'
   }.
 
-Arguments Compose {obj} [C s d d'] m1 m2 : rename.
+Arguments Compose {obj} [C s d d'] _ _ : rename.
 
 Inductive ReifiedMorphism : forall objC (C : SpecializedCategory objC), C -> C -> Type :=
 | ReifiedComposedMorphism : forall objC C s d d', ReifiedMorphism C d d' -> ReifiedMorphism C s d -> @ReifiedMorphism objC C s d'.
diff --git a/test-suite/bugs/closed/3070.v b/test-suite/bugs/closed/3070.v
new file mode 100644
index 000000000..7a8feca58
--- /dev/null
+++ b/test-suite/bugs/closed/3070.v
@@ -0,0 +1,6 @@
+(* Testing subst wrt chains of dependencies *)
+
+Lemma foo (a1 a2 : Set) (b1 : a1 -> Prop)
+      (Ha : a1 = a2) (c : a1) (d : b1 c) : True.
+Proof.
+  subst.
diff --git a/test-suite/bugs/closed/3209.v b/test-suite/bugs/closed/3209.v
new file mode 100644
index 000000000..855058b01
--- /dev/null
+++ b/test-suite/bugs/closed/3209.v
@@ -0,0 +1,75 @@
+(* Avoiding some occur-check *)
+
+(* 1. Original example *)
+
+Inductive eqT {A} (x : A) : A -> Type :=
+  reflT : eqT x x.
+Definition Bi_inv (A B : Type) (f : (A -> B)) :=
+  sigT (fun (g : B -> A) =>
+          sigT (fun (h : B -> A) =>
+                  sigT (fun (α : forall b : B, eqT (f (g b)) b) =>
+                          forall a : A, eqT (h (f a)) a))).
+Definition TEquiv (A B : Type) := sigT (fun (f : A -> B) => Bi_inv _ _ f).
+
+Axiom UA : forall (A B : Type), TEquiv (TEquiv A B) (eqT A B).
+Definition idtoeqv {A B} (e : eqT A B) : TEquiv A B :=
+  sigT_rect (fun _ => TEquiv A B)
+            (fun (f : TEquiv A B -> eqT A B) H =>
+               sigT_rect _ (* (fun _ => TEquiv A B) *)
+                         (fun g _ => g e)
+                         H)
+            (UA A B).
+
+(* 2. Alternative example by Guillaume *)
+
+Inductive foo (A : Prop) : Prop := Foo : foo A.
+Axiom bar : forall (A : Prop) (P : foo A -> Prop), (A -> P (Foo A)) -> Prop.
+
+(* This used to fail with a Not_found, we fail more graciously but a
+   heuristic could be implemented, e.g. in some smart occur-check
+   function, to find a solution of then form ?P := fun _ => ?P' *)
+
+Fail Check (fun e : ?[T] => bar ?[A] ?[P] (fun g : ?[A'] => g e)).
+
+(* This works and tells which solution we could have inferred *)
+
+Check (fun e : ?[T] => bar ?[A] (fun _ => ?[P]) (fun g : ?[A'] => g e)).
+
+(* For the record, here is the trace in the failing example:
+
+In (fun e : ?T => bar ?[A] ?[P] (fun g : ?A' => g e)), we have the existential variables
+
+e:?T |- ?A : Prop
+e:?T |- ?P : foo ?A -> Prop
+e:?T |- ?A' : Type
+
+with constraints
+
+?A' == ?A
+?A' == ?T -> ?P (Foo ?A)
+
+To type (g e), unification first defines
+
+?A := forall x:?B, ?P'{e:=e,x:=x}
+with ?T <= ?B
+and ?P'@{e:=e,x:=e} <= ?P@{e:=e} (Foo (forall x:?B, ?P'{e:=e,x:=x}))
+
+Then, since ?P'@{e:=e,x:=e} may use "e" in two different ways, it is
+not a pattern and we define a new
+
+e:?T x:?B|- ?P'' : foo (?B' -> ?P''') -> Prop
+
+for some ?B' and ?P''', together with
+
+?P'@{e,x} := ?P''{e:=e,x:=e} (Foo (?B -> ?P')
+?P@{e} := ?P''{e:=e,x:=e}
+
+Moreover, ?B' and ?P''' have to satisfy
+
+?B'@{e:=e,x:=e} == ?B@{e:=e}
+?P'''@{e:=e,x:=e} == ?P'@{e:=e,x:=x}
+
+and this leads to define ?P' which was the initial existential
+variable to define.
+*)
+
diff --git a/test-suite/bugs/closed/3251.v b/test-suite/bugs/closed/3251.v
index 5a7ae2002..d4ce050c5 100644
--- a/test-suite/bugs/closed/3251.v
+++ b/test-suite/bugs/closed/3251.v
@@ -1,4 +1,5 @@
 Goal True.
+idtac.
 Ltac foo := idtac.
 (* print out happens twice:
 foo is defined
diff --git a/test-suite/bugs/closed/3383.v b/test-suite/bugs/closed/3383.v
new file mode 100644
index 000000000..25257644a
--- /dev/null
+++ b/test-suite/bugs/closed/3383.v
@@ -0,0 +1,6 @@
+Goal forall b : bool, match b as b' return if b' then True else True with true => I | false => I end = match b as b' return if b' then True else True with true => I | false => I end.
+intro.
+lazymatch goal with
+| [ |- context[match ?b as b' in bool return @?P b' with true => ?t | false => ?f end] ]
+  => change (match b as b' in bool return P b' with true => t | false => f end) with (@bool_rect P t f b)
+end.
diff --git a/test-suite/bugs/closed/3424.v b/test-suite/bugs/closed/3424.v
index f9b2c3861..ee8cabf17 100644
--- a/test-suite/bugs/closed/3424.v
+++ b/test-suite/bugs/closed/3424.v
@@ -13,6 +13,7 @@ Notation "0" := (trunc_S minus_one) : trunc_scope.
 Class IsTrunc (n : trunc_index) (A : Type) : Type := Trunc_is_trunc : IsTrunc_internal n A.
 Notation IsHProp := (IsTrunc minus_one).
 Notation IsHSet := (IsTrunc 0).
+Set Refolding Reduction.
 Goal forall (A : Type) (a b : A) (H' : IsHSet A), { x : Type & IsHProp x }.
 Proof.
 intros.
diff --git a/test-suite/bugs/closed/3441.v b/test-suite/bugs/closed/3441.v
new file mode 100644
index 000000000..50d297807
--- /dev/null
+++ b/test-suite/bugs/closed/3441.v
@@ -0,0 +1,23 @@
+Axiom f : nat -> nat -> nat.
+Fixpoint do_n (n : nat) (k : nat) :=
+  match n with
+    | 0 => k
+    | S n' => do_n n' (f k k)
+  end.
+
+Notation big := (_ = _).
+Axiom k : nat.
+Goal True.
+Timeout 1 let H := fresh "H" in
+     let x := constr:(let n := 17 in do_n n = do_n n) in
+     let y := (eval lazy in x) in 
+     pose proof y as H. (* Finished transaction in 1.102 secs (1.084u,0.016s) (successful) *)
+Timeout 1 let H := fresh "H" in
+     let x := constr:(let n := 17 in do_n n = do_n n) in
+     let y := (eval lazy in x) in
+     pose y as H; clearbody H. (* Finished transaction in 0.412 secs (0.412u,0.s) (successful) *)
+
+Timeout 1 Time let H := fresh "H" in
+     let x := constr:(let n := 17 in do_n n = do_n n) in
+     let y := (eval lazy in x) in
+     assert (H := y). (* Finished transaction in 1.19 secs (1.164u,0.024s) (successful) *)
\ No newline at end of file
diff --git a/test-suite/bugs/closed/3495.v b/test-suite/bugs/closed/3495.v
new file mode 100644
index 000000000..102a2aba0
--- /dev/null
+++ b/test-suite/bugs/closed/3495.v
@@ -0,0 +1,18 @@
+Require Import RelationClasses.
+
+Axiom R : Prop -> Prop -> Prop.
+Declare Instance : Reflexive R.
+
+Class bar := { x : False }.
+Record foo := { a : Prop ; b : bar }.
+
+Definition default_foo (a0 : Prop) `{b : bar} : foo := {| a := a0 ; b := b |}.
+
+Goal exists k, R k True.
+Proof.
+eexists.
+evar (b : bar).
+let e := match goal with |- R ?e _ => constr:(e) end in
+unify e (a (default_foo True)).
+subst b.
+reflexivity.
diff --git a/test-suite/bugs/closed/3513.v b/test-suite/bugs/closed/3513.v
index fcdfa0057..9ed0926a6 100644
--- a/test-suite/bugs/closed/3513.v
+++ b/test-suite/bugs/closed/3513.v
@@ -1,4 +1,3 @@
-Require Import TestSuite.admit.
 (* File reduced by coq-bug-finder from original input, then from 5752 lines to 3828 lines, then from 2707 lines to 558 lines, then from 472 lines to 168 lines, then from 110 lines to 101 lines, then from 96 lines to 77 lines, then from 80 lines to 64 lines *)
 Require Coq.Setoids.Setoid.
 Import Coq.Setoids.Setoid.
@@ -35,7 +34,7 @@ Local Existing Instance ILFun_Ops.
 Local Existing Instance ILFun_ILogic.
 Definition catOP (P Q: OPred) : OPred := admit.
 Add Parametric Morphism : catOP with signature lentails ==> lentails ==> lentails as catOP_entails_m.
-admit.
+apply admit.
 Defined.
 Definition catOPA (P Q R : OPred) : catOP (catOP P Q) R -|- catOP P (catOP Q R) := admit.
 Class IsPointed (T : Type) := point : T.
@@ -69,8 +68,27 @@ Goal forall (T : Type) (O0 : T -> OPred) (O1 : T -> PointedOPred)
     pose P;
     refine (P _ _)
   end; unfold Basics.flip.
-  2: solve [ apply reflexivity ].
-  Undo.
-  2: reflexivity. (* Toplevel input, characters 18-29:
-Error:
-Tactic failure: The relation lentails is not a declared reflexive relation. Maybe you need to require the Setoid library. *)
\ No newline at end of file
+  Focus 2.
+  Set Typeclasses Debug.
+  Set Typeclasses Legacy Resolution.
+  apply reflexivity.
+  (* Debug: 1.1: apply @IsPointed_catOP on
+(IsPointed (exists x0 : Actions, (catOP ?Goal O2 : OPred) x0))
+Debug: 1.1.1.1: apply OPred_inhabited on (IsPointed (exists x0 : Actions, ?Goal x0))
+Debug: 1.1.2.1: apply OPred_inhabited on (IsPointed (exists x : Actions, O2 x))
+Debug: 2.1: apply @Equivalence_Reflexive on (Reflexive lentails)
+Debug: 2.1.1: no match for (Equivalence lentails) , 5 possibilities
+Debug: Backtracking after apply @Equivalence_Reflexive
+Debug: 2.2: apply @PreOrder_Reflexive on (Reflexive lentails)
+Debug: 2.2.1.1: apply @lentailsPre on (PreOrder lentails)
+Debug: 2.2.1.1.1.1: apply ILFun_ILogic on (ILogic OPred)
+*)
+  Undo. Unset Typeclasses Legacy Resolution.
+  Test Typeclasses Unique Solutions.
+  Test Typeclasses Unique Instances.
+  Show Existentials.
+  Set Typeclasses Debug Verbosity 2.
+  Set Printing All.
+  (* As in 8.5, allow a shelved subgoal to remain *)
+  apply reflexivity.
+  
\ No newline at end of file
diff --git a/test-suite/bugs/closed/3563.v b/test-suite/bugs/closed/3563.v
index 679721667..961563ed4 100644
--- a/test-suite/bugs/closed/3563.v
+++ b/test-suite/bugs/closed/3563.v
@@ -16,11 +16,11 @@ Goal forall (H H0 H1 : Type) (H2 : H1) (H3 : H1 -> H * H0)
        transport (fun y : H1 -> H * H0 => H5 (fst (y H2))) H4 H6 = H7.
   intros.
   match goal with
-    | [ |- appcontext ctx [transport (fun y => (?g (@fst ?C ?h (y H2)))) H4 H6] ]
+    | [ |- context ctx [transport (fun y => (?g (@fst ?C ?h (y H2)))) H4 H6] ]
       => set(foo:=h); idtac
   end.
   match goal with
-    | [ |- appcontext ctx [transport (fun y => (?g (fst (y H2))))] ]
+    | [ |- context ctx [transport (fun y => (?g (fst (y H2))))] ]
       => idtac
   end.
 Abort.
@@ -30,7 +30,7 @@ Goal forall (H H0 H1 : Type) (H2 : H1) (H3 : H1 -> (H1 -> H) * H0)
        transport (fun y : H1 -> (H1 -> H) * H0 => H5 (fst (y H2) H2)) H4 H6 = H7.
   intros.
   match goal with
-    | [ |- appcontext ctx [transport (fun y => (?g (@fst ?C ?D (y H2) ?X)))] ]
+    | [ |- context ctx [transport (fun y => (?g (@fst ?C ?D (y H2) ?X)))] ]
       => set(foo:=X)
   end.
 (* Anomaly: Uncaught exception Not_found(_). Please report. *)
diff --git a/test-suite/bugs/closed/3647.v b/test-suite/bugs/closed/3647.v
index 495e67e09..f5a22bd50 100644
--- a/test-suite/bugs/closed/3647.v
+++ b/test-suite/bugs/closed/3647.v
@@ -650,4 +650,5 @@ Goal    forall (ptest : program) (cond : Condition) (value : bool)
 
   Grab Existential Variables.
   subst_body; simpl.
-  refine (all_behead (projT2 _)).
+  Fail refine (all_behead (projT2 _)).
+  Unset Solve Unification Constraints. refine (all_behead (projT2 _)).
diff --git a/test-suite/bugs/closed/3649.v b/test-suite/bugs/closed/3649.v
index fc60897d2..fc4c171e2 100644
--- a/test-suite/bugs/closed/3649.v
+++ b/test-suite/bugs/closed/3649.v
@@ -2,6 +2,7 @@
 (* File reduced by coq-bug-finder from original input, then from 9518 lines to 404 lines, then from 410 lines to 208 lines, then from 162 lines to 77 lines *)
 (* coqc version trunk (September 2014) compiled on Sep 18 2014 21:0:5 with OCaml 4.01.0
    coqtop version cagnode16:/afs/csail.mit.edu/u/j/jgross/coq-trunk,trunk (07e4438bd758c2ced8caf09a6961ccd77d84e42b) *)
+Declare ML Module "coretactics".
 Reserved Notation "x -> y" (at level 99, right associativity, y at level 200).
 Reserved Notation "x = y" (at level 70, no associativity).
 Delimit Scope type_scope with type.
diff --git a/test-suite/bugs/closed/3690.v b/test-suite/bugs/closed/3690.v
index c24173abf..fd9640b89 100644
--- a/test-suite/bugs/closed/3690.v
+++ b/test-suite/bugs/closed/3690.v
@@ -47,7 +47,7 @@ Type@{Top.21} -> Type@{Top.23}
               Top.23 < Top.22
                *) *)
 Fail Check @qux@{Set Set}.
-Fail Check @qux@{Set Set Set}.
+Check @qux@{Type Type Type Type}.
 (* [qux] should only need two universes *)
-Check @qux@{i j k}.  (* Error: The command has not failed!, but I think this is suboptimal *)
+Check @qux@{i j k l}.  (* Error: The command has not failed!, but I think this is suboptimal *)
 Fail Check @qux@{i j}.
diff --git a/test-suite/bugs/closed/3699.v b/test-suite/bugs/closed/3699.v
index 8dadc2419..efa432526 100644
--- a/test-suite/bugs/closed/3699.v
+++ b/test-suite/bugs/closed/3699.v
@@ -34,8 +34,7 @@ Module NonPrim.
   : forall b:B, P b.
   Proof.
     intros b.
-    unshelve (refine (pr1 (isconnected_elim _ _))).
-    exact b.
+    unshelve (refine (pr1 (isconnected_elim (A:=hfiber f b) _ _))).
     intro x.
     exact (transport P x.2 (d x.1)).
   Defined.
@@ -47,8 +46,7 @@ Module NonPrim.
   : forall b:B, P b.
   Proof.
     intros b.
-    unshelve (refine (pr1 (isconnected_elim _ _))).
-    exact b.
+    unshelve (refine (pr1 (isconnected_elim (A:=hfiber f b) _ _))).
     intros [a p].
     exact (transport P p (d a)).
   Defined.
@@ -111,8 +109,7 @@ Module Prim.
   : forall b:B, P b.
   Proof.
     intros b.
-    unshelve (refine (pr1 (isconnected_elim _ _))).
-    exact b.
+    unshelve (refine (pr1 (isconnected_elim (A:=hfiber f b) _ _))).
     intro x.
     exact (transport P x.2 (d x.1)).
   Defined.
@@ -124,8 +121,7 @@ Module Prim.
   : forall b:B, P b.
   Proof.
     intros b.
-    unshelve (refine (pr1 (isconnected_elim _ _))).
-    exact b.
+    unshelve (refine (pr1 (isconnected_elim (A:=hfiber f b) _ _))).
     intros [a p].
     exact (transport P p (d a)).
   Defined.
diff --git a/test-suite/bugs/opened/3753.v b/test-suite/bugs/closed/3753.v
index 05d77c831..5bfbee949 100644
--- a/test-suite/bugs/opened/3753.v
+++ b/test-suite/bugs/closed/3753.v
@@ -1,4 +1,4 @@
 Axiom foo : Type -> Type.
 Axiom bar : forall (T : Type), T -> foo T.
 Arguments bar A x : rename.
-Fail About bar.
+About bar.
\ No newline at end of file
diff --git a/test-suite/bugs/closed/3825.v b/test-suite/bugs/closed/3825.v
index e594b74b6..666c64631 100644
--- a/test-suite/bugs/closed/3825.v
+++ b/test-suite/bugs/closed/3825.v
@@ -14,3 +14,11 @@ Notation qux := (nat -> nat).
 
 Fail Check qux@{i}.
 
+Axiom TruncType@{i} : nat -> Type@{i}.
+
+Notation "n -Type" := (TruncType n) (at level 1) : type_scope.
+Notation hProp := (0)-Type.
+
+Check hProp.
+Check hProp@{i}.
+
diff --git a/test-suite/bugs/closed/3886.v b/test-suite/bugs/closed/3886.v
new file mode 100644
index 000000000..2ac4abe54
--- /dev/null
+++ b/test-suite/bugs/closed/3886.v
@@ -0,0 +1,23 @@
+Require Import Program.
+
+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).
+
+Program Fixpoint doubleE {n} (e : Even n) : Even (2 * n)
+  := _
+with doubleO {n} (o : Odd n) : Odd (S (2 * n))
+     := _.
+Obligations.
+Axiom cheat : forall {A}, A.
+Obligation 1 of doubleE.
+apply cheat.
+Qed.
+
+Obligation 1 of doubleO.
+apply cheat.
+Qed.
+
+Check doubleE.
\ No newline at end of file
diff --git a/test-suite/bugs/closed/3920.v b/test-suite/bugs/closed/3920.v
new file mode 100644
index 000000000..a4adb23cc
--- /dev/null
+++ b/test-suite/bugs/closed/3920.v
@@ -0,0 +1,7 @@
+Require Import Setoid.
+Axiom P : nat -> Prop.
+Axiom P_or : forall x y, P (x + y) <-> P x \/ P y.
+Lemma foo (H : P 3) : False.
+eapply or_introl in H.
+erewrite <- P_or in H.
+(* Error: No such hypothesis: H *)
diff --git a/test-suite/bugs/closed/3929.v b/test-suite/bugs/closed/3929.v
index 4031dcc45..955581ef2 100644
--- a/test-suite/bugs/closed/3929.v
+++ b/test-suite/bugs/closed/3929.v
@@ -1,5 +1,36 @@
+Universes i j.
+Set Printing Universes.
+Set Printing All.
+Polymorphic Definition lt@{x y} : Type@{y} := Type@{x}.
 Goal True.
-evar (T:Type).
+evar (T:Type@{i}).
+set (Z := nat : Type@{j}). simpl in Z.
+let Tv:=eval cbv [T] in T in
+pose (x:=Tv).
+revert x.
+refine (_ : let x:=Z in True).
+(** This enforces i <= j *)
+Fail pose (lt@{i j}).
+let Zv:=eval cbv [Z] in Z in
+let Tv:=eval cbv [T] in T in
+constr_eq Zv Tv.
+exact I. 
+Defined.
+
+Goal True.
+evar (T:nat).
+pose (Z:=0).
+let Tv:=eval cbv [T] in T in
+pose (x:=Tv).
+revert x.
+refine (_ : let x:=Z in True).
+let Zv:=eval cbv [Z] in Z in
+let Tv:=eval cbv [T] in T in
+constr_eq Zv Tv.
+Abort.
+
+Goal True.
+evar (T:Set).
 pose (Z:=nat).
 let Tv:=eval cbv [T] in T in
 pose (x:=Tv).
@@ -10,3 +41,27 @@ let Tv:=eval cbv [T] in T in
 constr_eq Zv Tv.
 Abort.
 
+Goal forall (A:Type)(a:A), True.
+intros A a.
+evar (T:A).
+pose (Z:=a).
+let Tv:=eval cbv delta [T] in T in
+pose (x:=Tv).
+revert x.
+refine (_ : let x:=Z in True).
+let Zv:=eval cbv [Z] in Z in
+let Tv:=eval cbv [T] in T in
+constr_eq Zv Tv.
+Abort.
+
+Goal True.
+evar (T:Type).
+pose (Z:=nat).
+let Tv:=eval cbv [T] in T in
+pose (x:=Tv).
+revert x.
+refine (_ : let x:=Z in True).
+let Zv:=eval cbv [Z] in Z in
+let Tv:=eval cbv [T] in T in
+constr_eq Zv Tv.
+Abort.
diff --git a/test-suite/bugs/closed/4069.v b/test-suite/bugs/closed/4069.v
index 21b03ce54..61527764e 100644
--- a/test-suite/bugs/closed/4069.v
+++ b/test-suite/bugs/closed/4069.v
@@ -49,3 +49,56 @@ Lemma bar {A} n m (x : A) :
   skipn n (replicate m x) = replicate (m - n) x.
 Proof. intros. f_equal.
 (* 8.5: one goal, n = m - n *)
+Abort.
+
+Variable F : nat -> Set.
+Variable X : forall n, F (n + 1).
+
+Definition sequator{X Y: Set}{eq:X=Y}(x:X) : Y := eq_rec _ _ x _ eq.
+Definition tequator{X Y}{eq:X=Y}(x:X) : Y := eq_rect _ _ x _ eq.
+Polymorphic Definition pequator{X Y}{eq:X=Y}(x:X) : Y := eq_rect _ _ x _ eq.
+
+Goal {n:nat & F (S n)}.
+eexists.
+unshelve eapply (sequator (X _)).
+f_equal. (*behaves*)
+Undo 2.
+unshelve eapply (pequator (X _)).
+f_equal. (*behaves*)
+Undo 2.
+unshelve eapply (tequator (X _)).
+f_equal. (*behaves now *)
+Focus 2. exact 0.
+simpl.
+reflexivity.
+Defined.
+
+(* Part 2: modulo casts introduced by refine due to reductions in goals *)
+
+Goal {n:nat & F (S n)}.
+eexists.
+(*misbehaves, although same goal as above*)
+Set Printing All.
+unshelve refine (sequator (X _)); revgoals.
+2:exact 0. reflexivity.
+Undo 3. 
+unshelve refine (pequator (X _)); revgoals.
+f_equal.
+Undo 2.
+unshelve refine (tequator (X _)); revgoals.
+f_equal.
+Admitted.
+
+Goal @eq Set nat nat.
+congruence.
+Qed.
+
+Goal @eq Type nat nat.
+congruence. 
+Qed.
+
+Variable T : Type.
+
+Goal @eq Type T T.
+congruence.
+Qed.
\ No newline at end of file
diff --git a/test-suite/bugs/closed/4095.v b/test-suite/bugs/closed/4095.v
new file mode 100644
index 000000000..ffd33d381
--- /dev/null
+++ b/test-suite/bugs/closed/4095.v
@@ -0,0 +1,87 @@
+(* File reduced by coq-bug-finder from original input, then from 5752 lines to 3828 lines, then from 2707 lines to 558 lines, then from 472 lines to 168 lines, then from 110 lines to 101 lines, then from 96 lines to 77 lines, then from 80 lines to 64 lines, then from 92 lines to 79 lines *)
+(* coqc version 8.5beta1 (February 2015) compiled on Feb 23 2015 18:32:3 with OCaml 4.01.0
+   coqtop version cagnode15:/afs/csail.mit.edu/u/j/jgross/coq-8.5,v8.5 (ebfc19d792492417b129063fb511aa423e9d9e08) *)
+Require Import Coq.Setoids.Setoid.
+Generalizable All Variables.
+Axiom admit : forall {T}, T.
+Ltac admit := apply admit.
+Class Equiv (A : Type) := equiv : relation A.
+Class type (A : Type) {e : Equiv A} := eq_equiv : Equivalence equiv.
+Class ILogicOps Frm := { lentails: relation Frm;
+                         ltrue: Frm;
+                         land: Frm -> Frm -> Frm;
+                         lor: Frm -> Frm -> Frm }.
+Infix "|--"  := lentails (at level 79, no associativity).
+Class ILogic Frm {ILOps: ILogicOps Frm} := { lentailsPre:> PreOrder lentails }.
+Definition lequiv `{ILogic Frm} P Q := P |-- Q /\ Q |-- P.
+Infix "-|-"  := lequiv (at level 85, no associativity).
+Instance lequiv_inverse_lentails `{ILogic Frm} : subrelation lequiv (inverse lentails) := admit.
+Record ILFunFrm (T : Type) `{e : Equiv T} `{ILOps : ILogicOps Frm} := mkILFunFrm { ILFunFrm_pred :> T -> Frm }.
+Section ILogic_Fun.
+  Context (T: Type) `{TType: type T}.
+  Context `{IL: ILogic Frm}.
+  Local Instance ILFun_Ops : ILogicOps (@ILFunFrm T _ Frm _) := admit.
+  Definition ILFun_ILogic : ILogic (@ILFunFrm T _ Frm _) := admit.
+End ILogic_Fun.
+Implicit Arguments ILFunFrm [[ILOps] [e]].
+Instance ILogicOps_Prop : ILogicOps Prop | 2 := {| lentails P Q := (P : Prop) -> Q;
+                                                   ltrue        := True;
+                                                   land     P Q := P /\ Q;
+                                                   lor      P Q := P \/ Q |}.
+Axiom Action : Set.
+Definition Actions := list Action.
+Instance ActionsEquiv : Equiv Actions := { equiv a1 a2 := a1 = a2 }.
+Definition OPred := ILFunFrm Actions Prop.
+Local Existing Instance ILFun_Ops.
+Local Existing Instance ILFun_ILogic.
+Definition catOP (P Q: OPred) : OPred := admit.
+Add Parametric Morphism : catOP with signature lentails ==> lentails ==> lentails as catOP_entails_m.
+admit.
+Defined.
+Definition catOPA (P Q R : OPred) : catOP (catOP P Q) R -|- catOP P (catOP Q R) := admit.
+Class IsPointed (T : Type) := point : T.
+Notation IsPointed_OPred P := (IsPointed (exists x : Actions, (P : OPred) x)).
+Record PointedOPred := mkPointedOPred {
+                           OPred_pred :> OPred;
+                           OPred_inhabited: IsPointed_OPred OPred_pred
+                         }.
+Existing Instance OPred_inhabited.
+Canonical Structure default_PointedOPred O `{IsPointed_OPred O} : PointedOPred
+  := {| OPred_pred := O ; OPred_inhabited := _ |}.
+Instance IsPointed_catOP `{IsPointed_OPred P, IsPointed_OPred Q} : IsPointed_OPred (catOP P Q) := admit.
+Goal forall (T : Type) (O0 : T -> OPred) (O1 : T -> PointedOPred)
+            (tr : T -> T) (O2 : PointedOPred) (x : T)
+            (H : forall x0 : T, catOP (O0 x0) (O1 (tr x0)) |-- O1 x0),
+     exists e1 e2,
+       catOP (O0 e1) (OPred_pred e2) |-- catOP (O1 x) O2.
+  intros; do 2 esplit.
+  rewrite <- catOPA.
+  lazymatch goal with
+  | |- ?R (?f ?a ?b) (?f ?a' ?b') =>
+    let P := constr:(fun H H' => @Morphisms.proper_prf (OPred -> OPred -> OPred)
+         (@Morphisms.respectful OPred (OPred -> OPred)
+            (@lentails OPred
+               (@ILFun_Ops Actions ActionsEquiv Prop ILogicOps_Prop))
+            (@lentails OPred
+               (@ILFun_Ops Actions ActionsEquiv Prop ILogicOps_Prop) ==>
+             @lentails OPred
+               (@ILFun_Ops Actions ActionsEquiv Prop ILogicOps_Prop))) catOP
+         catOP_entails_m_Proper a a' H b b' H') in
+    pose P;
+    refine (P _ _)
+  end.
+  Undo.
+  Fail lazymatch goal with
+  | |- ?R (?f ?a ?b) (?f ?a' ?b') =>
+    let P := constr:(fun H H' => Morphisms.proper_prf a a' H b b' H') in
+    set(p:=P)
+  end. (* Toplevel input, characters 15-182:
+Error: Cannot infer an instance of type
+"PointedOPred" for the variable p in environment:
+T : Type
+O0 : T -> OPred
+O1 : T -> PointedOPred
+tr : T -> T
+O2 : PointedOPred
+x0 : T
+H : forall x0 : T, catOP (O0 x0) (O1 (tr x0)) |-- O1 x0 *)
\ No newline at end of file
diff --git a/test-suite/bugs/closed/4187.v b/test-suite/bugs/closed/4187.v
new file mode 100644
index 000000000..b13ca36a3
--- /dev/null
+++ b/test-suite/bugs/closed/4187.v
@@ -0,0 +1,709 @@
+(* Lifted from https://coq.inria.fr/bugs/show_bug.cgi?id=4187 *)
+(* File reduced by coq-bug-finder from original input, then from 715 lines to 696 lines *)
+(* coqc version 8.4pl5 (December 2014) compiled on Dec 28 2014 03:23:16 with OCaml 4.01.0
+   coqtop version 8.4pl5 (December 2014) *)
+Set Asymmetric Patterns.
+Axiom proof_admitted : False.
+Tactic Notation "admit" := case proof_admitted.
+Require Import Coq.Lists.List.
+Require Import Coq.Setoids.Setoid.
+Require Import Coq.Numbers.Natural.Peano.NPeano.
+Global Set Implicit Arguments.
+Global Generalizable All Variables.
+Coercion is_true : bool >-> Sortclass.
+Coercion bool_of_sumbool {A B} (x : {A} + {B}) : bool := if x then true else false.
+Fixpoint ForallT {T} (P : T -> Type) (ls : list T) : Type
+  := match ls return Type with
+       | nil => True
+       | x::xs => (P x * ForallT P xs)%type
+     end.
+Fixpoint Forall_tails {T} (P : list T -> Type) (ls : list T) : Type
+  := match ls with
+       | nil => P nil
+       | x::xs => (P (x::xs) * Forall_tails P xs)%type
+     end.
+
+Module Export ADTSynthesis_DOT_Common_DOT_Wf.
+Module Export ADTSynthesis.
+Module Export Common.
+Module Export Wf.
+
+Section wf.
+  Section wf_prod.
+    Context A B (RA : relation A) (RB : relation B).
+Definition prod_relation : relation (A * B).
+exact (fun ab a'b' =>
+           RA (fst ab) (fst a'b') \/ (fst a'b' = fst ab /\ RB (snd ab) (snd a'b'))).
+Defined.
+
+    Fixpoint well_founded_prod_relation_helper
+             a b
+             (wf_A : Acc RA a) (wf_B : well_founded RB) {struct wf_A}
+    : Acc prod_relation (a, b)
+      := match wf_A with
+           | Acc_intro fa => (fix wf_B_rec b' (wf_B' : Acc RB b') : Acc prod_relation (a, b')
+                              := Acc_intro
+                                   _
+                                   (fun ab =>
+                                      match ab as ab return prod_relation ab (a, b') -> Acc prod_relation ab with
+                                        | (a'', b'') =>
+                                          fun pf =>
+                                            match pf with
+                                              | or_introl pf'
+                                                => @well_founded_prod_relation_helper
+                                                     _ _
+                                                     (fa _ pf')
+                                                     wf_B
+                                              | or_intror (conj pfa pfb)
+                                                => match wf_B' with
+                                                     | Acc_intro fb
+                                                       => eq_rect
+                                                            _
+                                                            (fun a'' => Acc prod_relation (a'', b''))
+                                                            (wf_B_rec _ (fb _ pfb))
+                                                            _
+                                                            pfa
+                                                   end
+                                            end
+                                      end)
+                             ) b (wf_B b)
+         end.
+
+    Definition well_founded_prod_relation : well_founded RA -> well_founded RB -> well_founded prod_relation.
+    Proof.
+      intros wf_A wf_B [a b]; hnf in *.
+      apply well_founded_prod_relation_helper; auto.
+    Defined.
+  End wf_prod.
+
+  Section wf_projT1.
+    Context A (B : A -> Type) (R : relation A).
+Definition projT1_relation : relation (sigT B).
+exact (fun ab a'b' =>
+           R (projT1 ab) (projT1 a'b')).
+Defined.
+
+    Definition well_founded_projT1_relation : well_founded R -> well_founded projT1_relation.
+    Proof.
+      intros wf [a b]; hnf in *.
+      induction (wf a) as [a H IH].
+      constructor.
+      intros y r.
+      specialize (IH _ r (projT2 y)).
+      destruct y.
+      exact IH.
+    Defined.
+  End wf_projT1.
+End wf.
+
+Section Fix3.
+  Context A (B : A -> Type) (C : forall a, B a -> Type) (D : forall a b, C a b -> Type)
+          (R : A -> A -> Prop) (Rwf : well_founded R)
+          (P : forall a b c, D a b c -> Type)
+          (F : forall x : A, (forall y : A, R y x -> forall b c d, P y b c d) -> forall b c d, P x b c d).
+Definition Fix3 a b c d : @P a b c d.
+exact (@Fix { a : A & { b : B a & { c : C b & D c } } }
+            (fun x y => R (projT1 x) (projT1 y))
+            (well_founded_projT1_relation Rwf)
+            (fun abcd => P (projT2 (projT2 (projT2 abcd))))
+            (fun x f => @F (projT1 x) (fun y r b c d => f (existT _ y (existT _ b (existT _ c d))) r) _ _ _)
+            (existT _ a (existT _ b (existT _ c d)))).
+Defined.
+End Fix3.
+
+End Wf.
+
+End Common.
+
+End ADTSynthesis.
+
+End ADTSynthesis_DOT_Common_DOT_Wf.
+
+Module Export ADTSynthesis_DOT_Parsers_DOT_StringLike_DOT_Core.
+Module Export ADTSynthesis.
+Module Export Parsers.
+Module Export StringLike.
+Module Export Core.
+Import Coq.Setoids.Setoid.
+Import Coq.Classes.Morphisms.
+
+
+
+Module Export StringLike.
+  Class StringLike {Char : Type} :=
+    {
+      String :> Type;
+      is_char : String -> Char -> bool;
+      length : String -> nat;
+      take : nat -> String -> String;
+      drop : nat -> String -> String;
+      bool_eq : String -> String -> bool;
+      beq : relation String := fun x y => bool_eq x y
+    }.
+
+  Arguments StringLike : clear implicits.
+  Infix "=s" := (@beq _ _) (at level 70, no associativity) : type_scope.
+  Notation "s ~= [ ch ]" := (is_char s ch) (at level 70, no associativity) : string_like_scope.
+  Local Open Scope string_like_scope.
+
+  Definition str_le `{StringLike Char} (s1 s2 : String)
+    := length s1 < length s2 \/ s1 =s s2.
+  Infix "≤s" := str_le (at level 70, right associativity).
+
+  Class StringLikeProperties (Char : Type) `{StringLike Char} :=
+    {
+      singleton_unique : forall s ch ch', s ~= [ ch ] -> s ~= [ ch' ] -> ch = ch';
+      length_singleton : forall s ch, s ~= [ ch ] -> length s = 1;
+      bool_eq_char : forall s s' ch, s ~= [ ch ] -> s' ~= [ ch ] -> s =s s';
+      is_char_Proper :> Proper (beq ==> eq ==> eq) is_char;
+      length_Proper :> Proper (beq ==> eq) length;
+      take_Proper :> Proper (eq ==> beq ==> beq) take;
+      drop_Proper :> Proper (eq ==> beq ==> beq) drop;
+      bool_eq_Equivalence :> Equivalence beq;
+      bool_eq_empty : forall str str', length str = 0 -> length str' = 0 -> str =s str';
+      take_short_length : forall str n, n <= length str -> length (take n str) = n;
+      take_long : forall str n, length str <= n -> take n str =s str;
+      take_take : forall str n m, take n (take m str) =s take (min n m) str;
+      drop_length : forall str n, length (drop n str) = length str - n;
+      drop_0 : forall str, drop 0 str =s str;
+      drop_drop : forall str n m, drop n (drop m str) =s drop (n + m) str;
+      drop_take : forall str n m, drop n (take m str) =s take (m - n) (drop n str);
+      take_drop : forall str n m, take n (drop m str) =s drop m (take (n + m) str)
+    }.
+
+  Arguments StringLikeProperties Char {_}.
+End StringLike.
+
+End Core.
+
+End StringLike.
+
+End Parsers.
+
+End ADTSynthesis.
+
+End ADTSynthesis_DOT_Parsers_DOT_StringLike_DOT_Core.
+
+Module Export ADTSynthesis.
+Module Export Parsers.
+Module Export ContextFreeGrammar.
+Require Import Coq.Strings.String.
+Require Import Coq.Lists.List.
+Export ADTSynthesis.Parsers.StringLike.Core.
+Import ADTSynthesis.Common.
+
+Local Open Scope string_like_scope.
+
+Section cfg.
+  Context {Char : Type}.
+
+  Section definitions.
+
+    Inductive item :=
+    | Terminal (_ : Char)
+    | NonTerminal (_ : string).
+
+    Definition production := list item.
+    Definition productions := list production.
+
+    Record grammar :=
+      {
+        Start_symbol :> string;
+        Lookup :> string -> productions;
+        Start_productions :> productions := Lookup Start_symbol;
+        Valid_nonterminals : list string;
+        Valid_productions : list productions := map Lookup Valid_nonterminals
+      }.
+  End definitions.
+
+  Section parse.
+    Context {HSL : StringLike Char}.
+    Variable G : grammar.
+
+    Inductive parse_of (str : String) : productions -> Type :=
+    | ParseHead : forall pat pats, parse_of_production str pat
+                                   -> parse_of str (pat::pats)
+    | ParseTail : forall pat pats, parse_of str pats
+                                   -> parse_of str (pat::pats)
+    with parse_of_production (str : String) : production -> Type :=
+    | ParseProductionNil : length str = 0 -> parse_of_production str nil
+    | ParseProductionCons : forall n pat pats,
+                              parse_of_item (take n str) pat
+                              -> parse_of_production (drop n str) pats
+                              -> parse_of_production str (pat::pats)
+    with parse_of_item (str : String) : item -> Type :=
+    | ParseTerminal : forall ch, str ~= [ ch ] -> parse_of_item str (Terminal ch)
+    | ParseNonTerminal : forall nt, parse_of str (Lookup G nt)
+                                    -> parse_of_item str (NonTerminal nt).
+  End parse.
+End cfg.
+
+Arguments item _ : clear implicits.
+Arguments production _ : clear implicits.
+Arguments productions _ : clear implicits.
+Arguments grammar _ : clear implicits.
+
+End ContextFreeGrammar.
+
+Module Export BaseTypes.
+
+Section recursive_descent_parser.
+
+  Class parser_computational_predataT :=
+    { nonterminals_listT : Type;
+      initial_nonterminals_data : nonterminals_listT;
+      is_valid_nonterminal : nonterminals_listT -> String.string -> bool;
+      remove_nonterminal : nonterminals_listT -> String.string -> nonterminals_listT;
+      nonterminals_listT_R : nonterminals_listT -> nonterminals_listT -> Prop;
+      remove_nonterminal_dec : forall ls nonterminal,
+                                 is_valid_nonterminal ls nonterminal
+                                 -> nonterminals_listT_R (remove_nonterminal ls nonterminal) ls;
+      ntl_wf : well_founded nonterminals_listT_R }.
+
+  Class parser_removal_dataT' `{predata : parser_computational_predataT} :=
+    { remove_nonterminal_1
+      : forall ls ps ps',
+          is_valid_nonterminal (remove_nonterminal ls ps) ps'
+          -> is_valid_nonterminal ls ps';
+      remove_nonterminal_2
+      : forall ls ps ps',
+          is_valid_nonterminal (remove_nonterminal ls ps) ps' = false
+          <-> is_valid_nonterminal ls ps' = false \/ ps = ps' }.
+End recursive_descent_parser.
+
+End BaseTypes.
+Import Coq.Lists.List.
+Import ADTSynthesis.Parsers.ContextFreeGrammar.
+
+Local Open Scope string_like_scope.
+
+Section cfg.
+  Context {Char} {HSL : StringLike Char} {G : grammar Char}.
+  Context {predata : @parser_computational_predataT}
+          {rdata' : @parser_removal_dataT' predata}.
+
+  Inductive minimal_parse_of
+  : forall (str0 : String) (valid : nonterminals_listT)
+           (str : String),
+      productions Char -> Type :=
+  | MinParseHead : forall str0 valid str pat pats,
+                     @minimal_parse_of_production str0 valid str pat
+                     -> @minimal_parse_of str0 valid str (pat::pats)
+  | MinParseTail : forall str0 valid str pat pats,
+                     @minimal_parse_of str0 valid str pats
+                     -> @minimal_parse_of str0 valid str (pat::pats)
+  with minimal_parse_of_production
+  : forall (str0 : String) (valid : nonterminals_listT)
+           (str : String),
+      production Char -> Type :=
+  | MinParseProductionNil : forall str0 valid str,
+                              length str = 0
+                              -> @minimal_parse_of_production str0 valid str nil
+  | MinParseProductionCons : forall str0 valid str n pat pats,
+                               str ≤s str0
+                               -> @minimal_parse_of_item str0 valid (take n str) pat
+                               -> @minimal_parse_of_production str0 valid (drop n str) pats
+                               -> @minimal_parse_of_production str0 valid str (pat::pats)
+  with minimal_parse_of_item
+  : forall (str0 : String) (valid : nonterminals_listT)
+           (str : String),
+      item Char -> Type :=
+  | MinParseTerminal : forall str0 valid str ch,
+                         str ~= [ ch ]
+                         -> @minimal_parse_of_item str0 valid str (Terminal ch)
+  | MinParseNonTerminal
+    : forall str0 valid str (nt : String.string),
+        @minimal_parse_of_nonterminal str0 valid str nt
+        -> @minimal_parse_of_item str0 valid str (NonTerminal nt)
+  with minimal_parse_of_nonterminal
+  : forall (str0 : String) (valid : nonterminals_listT)
+           (str : String),
+      String.string -> Type :=
+  | MinParseNonTerminalStrLt
+    : forall str0 valid (nt : String.string) str,
+        length str < length str0
+        -> is_valid_nonterminal initial_nonterminals_data nt
+        -> @minimal_parse_of str initial_nonterminals_data str (Lookup G nt)
+        -> @minimal_parse_of_nonterminal str0 valid str nt
+  | MinParseNonTerminalStrEq
+    : forall str0 str valid nonterminal,
+        str =s str0
+        -> is_valid_nonterminal initial_nonterminals_data nonterminal
+        -> is_valid_nonterminal valid nonterminal
+        -> @minimal_parse_of str0 (remove_nonterminal valid nonterminal) str (Lookup G nonterminal)
+        -> @minimal_parse_of_nonterminal str0 valid str nonterminal.
+End cfg.
+Import ADTSynthesis.Common.
+
+Section general.
+  Context {Char} {HSL : StringLike Char} {G : grammar Char}.
+
+  Class boolean_parser_dataT :=
+    { predata :> parser_computational_predataT;
+      split_string_for_production
+      : item Char -> production Char -> String -> list nat }.
+
+  Global Coercion predata : boolean_parser_dataT >-> parser_computational_predataT.
+
+  Definition split_list_completeT `{data : @parser_computational_predataT}
+             {str0 valid}
+             (it : item Char) (its : production Char)
+             (str : String)
+             (pf : str ≤s str0)
+             (split_list : list nat)
+
+    := ({ n : nat
+              & (minimal_parse_of_item (G := G) (predata := data) str0 valid (take n str) it)
+                * (minimal_parse_of_production (G := G) str0 valid (drop n str) its) }%type)
+       -> ({ n : nat
+                 & (In n split_list)
+                   * (minimal_parse_of_item (G := G) str0 valid (take n str) it)
+                   * (minimal_parse_of_production (G := G) str0 valid (drop n str) its) }%type).
+
+  Class boolean_parser_completeness_dataT' `{data : boolean_parser_dataT} :=
+    { split_string_for_production_complete
+      : forall str0 valid str (pf : str ≤s str0) nt,
+          is_valid_nonterminal initial_nonterminals_data nt
+          -> ForallT
+               (Forall_tails
+                  (fun prod
+                   => match prod return Type with
+                        | nil => True
+                        | it::its
+                          => @split_list_completeT data str0 valid it its str pf (split_string_for_production it its str)
+                      end))
+               (Lookup G nt) }.
+End general.
+
+Module Export BooleanRecognizer.
+Import Coq.Numbers.Natural.Peano.NPeano.
+Import Coq.Arith.Compare_dec.
+Import Coq.Arith.Wf_nat.
+
+Section recursive_descent_parser.
+  Context {Char} {HSL : StringLike Char} {HSLP : StringLikeProperties Char} {G : grammar Char}.
+  Context {data : @boolean_parser_dataT Char _}.
+
+  Section bool.
+    Section parts.
+Definition parse_item
+                 (str_matches_nonterminal : String.string -> bool)
+                 (str : String)
+                 (it : item Char)
+      : bool.
+Admitted.
+
+      Section production.
+        Context {str0}
+                (parse_nonterminal
+                 : forall (str : String),
+                     str ≤s str0
+                     -> String.string
+                     -> bool).
+
+        Fixpoint parse_production
+                 (str : String)
+                 (pf : str ≤s str0)
+                 (prod : production Char)
+        : bool.
+        Proof.
+          refine
+            match prod with
+              | nil =>
+
+                Nat.eq_dec (length str) 0
+              | it::its
+                => let parse_production' := fun str pf => parse_production str pf its in
+                   fold_right
+                     orb
+                     false
+                     (map (fun n =>
+                             (parse_item
+                                (parse_nonterminal (str := take n str) _)
+                                (take n str)
+                                it)
+                               && parse_production' (drop n str) _)%bool
+                          (split_string_for_production it its str))
+            end;
+          revert pf; clear -HSLP; intros; admit.
+        Defined.
+      End production.
+
+      Section productions.
+        Context {str0}
+                (parse_nonterminal
+                 : forall (str : String)
+                          (pf : str ≤s str0),
+                     String.string -> bool).
+Definition parse_productions
+                   (str : String)
+                   (pf : str ≤s str0)
+                   (prods : productions Char)
+        : bool.
+exact (fold_right orb
+                        false
+                        (map (parse_production parse_nonterminal pf)
+                             prods)).
+Defined.
+      End productions.
+
+      Section nonterminals.
+        Section step.
+          Context {str0 valid}
+                  (parse_nonterminal
+                   : forall (p : String * nonterminals_listT),
+                       prod_relation (ltof _ length) nonterminals_listT_R p (str0, valid)
+                       -> forall str : String,
+                            str ≤s fst p -> String.string -> bool).
+
+          Definition parse_nonterminal_step
+                     (str : String)
+                     (pf : str ≤s str0)
+                     (nt : String.string)
+          : bool.
+          Proof.
+            refine
+              (if lt_dec (length str) (length str0)
+               then
+                 parse_productions
+                   (@parse_nonterminal
+                      (str : String, initial_nonterminals_data)
+                      (or_introl _))
+                   (or_intror (reflexivity _))
+                   (Lookup G nt)
+               else
+                 if Sumbool.sumbool_of_bool (is_valid_nonterminal valid nt)
+                 then
+                   parse_productions
+                     (@parse_nonterminal
+                        (str0 : String, remove_nonterminal valid nt)
+                        (or_intror (conj eq_refl (remove_nonterminal_dec _ nt _))))
+                     (str := str)
+                     _
+                     (Lookup G nt)
+                 else
+                   false);
+            assumption.
+          Defined.
+        End step.
+
+        Section wf.
+Definition parse_nonterminal_or_abort
+          : forall (p : String * nonterminals_listT)
+                   (str : String),
+              str ≤s fst p
+              -> String.string
+              -> bool.
+exact (Fix3
+                 _ _ _
+                 (well_founded_prod_relation
+                    (well_founded_ltof _ length)
+                    ntl_wf)
+                 _
+                 (fun sl => @parse_nonterminal_step (fst sl) (snd sl))).
+Defined.
+Definition parse_nonterminal
+                     (str : String)
+                     (nt : String.string)
+          : bool.
+exact (@parse_nonterminal_or_abort
+                 (str : String, initial_nonterminals_data) str
+                 (or_intror (reflexivity _)) nt).
+Defined.
+        End wf.
+      End nonterminals.
+    End parts.
+  End bool.
+End recursive_descent_parser.
+
+Section cfg.
+  Context {Char} {HSL : StringLike Char} {HSLP : @StringLikeProperties Char HSL} (G : grammar Char).
+
+  Section definitions.
+    Context (P : String -> String.string -> Type).
+
+    Definition Forall_parse_of_item'
+               (Forall_parse_of : forall {str pats} (p : parse_of G str pats), Type)
+               {str it} (p : parse_of_item G str it)
+      := match p return Type with
+           | ParseTerminal ch pf => unit
+           | ParseNonTerminal nt p'
+             => (P str nt * Forall_parse_of p')%type
+         end.
+
+    Fixpoint Forall_parse_of {str pats} (p : parse_of G str pats)
+      := match p with
+           | ParseHead pat pats p'
+             => Forall_parse_of_production p'
+           | ParseTail _ _ p'
+             => Forall_parse_of p'
+         end
+    with Forall_parse_of_production {str pat} (p : parse_of_production G str pat)
+         := match p return Type with
+              | ParseProductionNil pf => unit
+              | ParseProductionCons pat strs pats p' p''
+                => (Forall_parse_of_item' (@Forall_parse_of) p' * Forall_parse_of_production p'')%type
+            end.
+
+    Definition Forall_parse_of_item {str it} (p : parse_of_item G str it)
+      := @Forall_parse_of_item' (@Forall_parse_of) str it p.
+  End definitions.
+
+  End cfg.
+
+Section recursive_descent_parser_list.
+  Context {Char} {HSL : StringLike Char} {HLSP : StringLikeProperties Char} {G : grammar Char}.
+Definition rdp_list_nonterminals_listT : Type.
+exact (list String.string).
+Defined.
+Definition rdp_list_is_valid_nonterminal : rdp_list_nonterminals_listT -> String.string -> bool.
+admit.
+Defined.
+Definition rdp_list_remove_nonterminal : rdp_list_nonterminals_listT -> String.string -> rdp_list_nonterminals_listT.
+admit.
+Defined.
+Definition rdp_list_nonterminals_listT_R : rdp_list_nonterminals_listT -> rdp_list_nonterminals_listT -> Prop.
+exact (ltof _ (@List.length _)).
+Defined.
+  Lemma rdp_list_remove_nonterminal_dec : forall ls prods,
+                                            @rdp_list_is_valid_nonterminal ls prods = true
+                                            -> @rdp_list_nonterminals_listT_R (@rdp_list_remove_nonterminal ls prods) ls.
+admit.
+Defined.
+  Lemma rdp_list_ntl_wf : well_founded rdp_list_nonterminals_listT_R.
+  Proof.
+    unfold rdp_list_nonterminals_listT_R.
+    intro.
+    apply well_founded_ltof.
+  Defined.
+
+  Global Instance rdp_list_predata : parser_computational_predataT
+    := { nonterminals_listT := rdp_list_nonterminals_listT;
+         initial_nonterminals_data := Valid_nonterminals G;
+         is_valid_nonterminal := rdp_list_is_valid_nonterminal;
+         remove_nonterminal := rdp_list_remove_nonterminal;
+         nonterminals_listT_R := rdp_list_nonterminals_listT_R;
+         remove_nonterminal_dec := rdp_list_remove_nonterminal_dec;
+         ntl_wf := rdp_list_ntl_wf }.
+End recursive_descent_parser_list.
+
+Section sound.
+  Section general.
+    Context {Char} {HSL : StringLike Char} {HSLP : StringLikeProperties Char} (G : grammar Char).
+    Context {data : @boolean_parser_dataT Char _}
+            {cdata : @boolean_parser_completeness_dataT' Char _ G data}
+            {rdata : @parser_removal_dataT' predata}.
+
+    Section parts.
+
+      Section nonterminals.
+        Section wf.
+
+          Lemma parse_nonterminal_sound
+                (str : String) (nonterminal : String.string)
+          : parse_nonterminal (G := G) str nonterminal
+            = true
+            -> parse_of_item G str (NonTerminal nonterminal).
+admit.
+Defined.
+        End wf.
+      End nonterminals.
+    End parts.
+  End general.
+End sound.
+
+Import Coq.Strings.String.
+Import ADTSynthesis.Parsers.ContextFreeGrammar.
+
+Fixpoint list_to_productions {T} (default : T) (ls : list (string * T)) : string -> T
+  := match ls with
+       | nil => fun _ => default
+       | (str, t)::ls' => fun s => if string_dec str s
+                                   then t
+                                   else list_to_productions default ls' s
+     end.
+
+Fixpoint list_to_grammar {T} (default : productions T) (ls : list (string * productions T)) : grammar T
+  := {| Start_symbol := hd ""%string (map (@fst _ _) ls);
+        Lookup := list_to_productions default ls;
+        Valid_nonterminals := map (@fst _ _) ls |}.
+
+Section interface.
+  Context {Char} (G : grammar Char).
+Definition production_is_reachable (p : production Char) : Prop.
+admit.
+Defined.
+Definition split_list_is_complete `{HSL : StringLike Char} (str : String) (it : item Char) (its : production Char)
+             (splits : list nat)
+  : Prop.
+exact (forall n,
+         n <= length str
+         -> parse_of_item G (take n str) it
+         -> parse_of_production G (drop n str) its
+         -> production_is_reachable (it::its)
+         -> List.In n splits).
+Defined.
+
+  Record Splitter :=
+    {
+      string_type :> StringLike Char;
+      splits_for : String -> item Char -> production Char -> list nat;
+
+      string_type_properties :> StringLikeProperties Char;
+      splits_for_complete : forall str it its,
+                              split_list_is_complete str it its (splits_for str it its)
+
+    }.
+  Global Existing Instance string_type_properties.
+
+  Record Parser (HSL : StringLike Char) :=
+    {
+      has_parse : @String Char HSL -> bool;
+
+      has_parse_sound : forall str,
+                          has_parse str = true
+                          -> parse_of_item G str (NonTerminal (Start_symbol G));
+
+      has_parse_complete : forall str (p : parse_of_item G str (NonTerminal (Start_symbol G))),
+                             Forall_parse_of_item
+                               (fun _ nt => List.In nt (Valid_nonterminals G))
+                               p
+                             -> has_parse str = true
+    }.
+End interface.
+
+Module Export ParserImplementation.
+
+Section implementation.
+  Context {Char} {G : grammar Char}.
+  Context (splitter : Splitter G).
+
+  Local Instance parser_data : @boolean_parser_dataT Char _ :=
+    { predata := rdp_list_predata (G := G);
+      split_string_for_production it its str
+      := splits_for splitter str it its }.
+
+  Program Definition parser : Parser G splitter
+    := {| has_parse str := parse_nonterminal (G := G) (data := parser_data) str (Start_symbol G);
+          has_parse_sound str Hparse := parse_nonterminal_sound G _ _ Hparse;
+          has_parse_complete str p Hp := _ |}.
+  Next Obligation.
+admit.
+Defined.
+End implementation.
+
+End ParserImplementation.
+
+Section implementation.
+  Context {Char} {ls : list (String.string * productions Char)}.
+  Local Notation G := (list_to_grammar (nil::nil) ls) (only parsing).
+  Context (splitter : Splitter G).
+
+  Local Instance parser_data : @boolean_parser_dataT Char _ := parser_data splitter.
+
+  Goal forall str : @String Char splitter,
+         let G' :=
+             @BooleanRecognizer.parse_nonterminal Char splitter splitter G parser_data str G = true in
+         G'.
+    intros str G'.
+    Timeout 1 assert (pf' : G' -> Prop) by abstract admit.
diff --git a/test-suite/bugs/closed/4198.v b/test-suite/bugs/closed/4198.v
index f85a60264..eb37141bc 100644
--- a/test-suite/bugs/closed/4198.v
+++ b/test-suite/bugs/closed/4198.v
@@ -11,7 +11,7 @@ Goal forall A (x x' : A) (xs xs' : list A) (H : x::xs = x'::xs'),
   simpl.
   intros.
   match goal with
-    | [ |- appcontext G[@hd] ] => idtac
+    | [ |- context G[@hd] ] => idtac
   end.
 
 (* This second example comes from CFGV where inspecting subterms of a
diff --git a/test-suite/bugs/closed/4375.v b/test-suite/bugs/closed/4375.v
index 03af16535..71e3a7518 100644
--- a/test-suite/bugs/closed/4375.v
+++ b/test-suite/bugs/closed/4375.v
@@ -93,14 +93,15 @@ Polymorphic CoInductive foo@{i} (T : Type@{i}) : Type@{i} :=
 | A : foo T -> foo T.
 
 Polymorphic CoFixpoint cg@{i} (t : Type@{i}) : foo@{i} t :=
-  @A@{i} t (cg@{i} t).
+  @A@{i} t (cg t).
 
 Print cg.
 
 Polymorphic CoFixpoint ca@{i} (t : Type@{i}) : foo@{i} t :=
-  @A@{i} t (@cb@{i} t)
+  @A@{i} t (cb t)
 with cb@{i} (t : Type@{i}) : foo@{i} t :=
-  @A@{i} t (@ca@{i} t).
+  @A@{i} t (ca t).
 
 Print ca.
-Print cb.
\ No newline at end of file
+Print cb.
+  
\ No newline at end of file
diff --git a/test-suite/bugs/closed/4416.v b/test-suite/bugs/closed/4416.v
new file mode 100644
index 000000000..3189685ec
--- /dev/null
+++ b/test-suite/bugs/closed/4416.v
@@ -0,0 +1,4 @@
+Goal exists x, x.
+Unset Solve Unification Constraints.
+unshelve refine (ex_intro _ _ _); match goal with _ => refine (_ _) end.
+(* Error: Incorrect number of goals (expected 2 tactics). *)
\ No newline at end of file
diff --git a/test-suite/bugs/closed/4450.v b/test-suite/bugs/closed/4450.v
new file mode 100644
index 000000000..ecebaba81
--- /dev/null
+++ b/test-suite/bugs/closed/4450.v
@@ -0,0 +1,58 @@
+Polymorphic Axiom inhabited@{u} : Type@{u} -> Prop.
+
+Polymorphic Axiom unit@{u} : Type@{u}.
+Polymorphic Axiom tt@{u} : inhabited unit@{u}.
+
+Polymorphic Hint Resolve tt : the_lemmas.
+Set Printing All.
+Set Printing Universes.
+Goal inhabited unit.
+Proof.
+  eauto with the_lemmas.
+Qed.
+
+Universe u.
+Axiom f : Type@{u} -> Prop.
+Lemma fapp (X : Type) : f X -> False.
+Admitted.
+Polymorphic Axiom funi@{i} : f unit@{i}.
+
+Goal (forall U, f U) -> (*(f unit -> False) ->  *)False /\ False.
+  eauto using (fapp unit funi). (* The two fapp's have different universes *)
+Qed.
+
+Hint Resolve (fapp unit funi) : mylems.
+
+Goal (forall U, f U) -> (*(f unit -> False) ->  *)False /\ False.
+  eauto with mylems. (* Forces the two fapps at the same level *)
+Qed.
+
+Goal (forall U, f U) -> (f unit -> False) -> False /\ False.
+  eauto. (* Forces the two fapps at the same level *)
+Qed.
+
+Polymorphic Definition MyType@{i} := Type@{i}.
+Universes l m n.
+Constraint l < m.
+Polymorphic Axiom maketype@{i} : MyType@{i}.
+
+Goal MyType@{l}.
+Proof.
+  Fail solve [ eauto using maketype@{m} ].
+  eauto using maketype.
+  Undo.
+  eauto using maketype@{n}.
+Qed.
+
+Axiom foo : forall (A : Type), list A.
+Polymorphic Axiom foop@{i} : forall (A : Type@{i}), list A.
+
+Universe x y.
+Goal list Type@{x}.
+Proof.
+  eauto using (foo Type). (* Refreshes the term *)
+  Undo.
+  eauto using foo. Show Universes.
+  Undo.
+  eauto using foop. Show Proof. Show Universes.
+Qed.
\ No newline at end of file
diff --git a/test-suite/bugs/closed/4464.v b/test-suite/bugs/closed/4464.v
new file mode 100644
index 000000000..f8e9405d9
--- /dev/null
+++ b/test-suite/bugs/closed/4464.v
@@ -0,0 +1,4 @@
+Goal True -> True.
+Proof.
+  intro H'.
+  let H := H' in destruct H; try destruct H.
diff --git a/test-suite/bugs/closed/4471.v b/test-suite/bugs/closed/4471.v
new file mode 100644
index 000000000..36efc42d4
--- /dev/null
+++ b/test-suite/bugs/closed/4471.v
@@ -0,0 +1,6 @@
+Goal forall (A B : Type) (P : forall _ : prod A B, Type) (a : A) (b : B) (p p0 : forall (x : A) (x' : B), P (@pair A B x x')),
+    @eq (P (@pair A B a b)) (p (@fst A B (@pair A B a b)) (@snd A B (@pair A B a b)))
+        (p0 (@fst A B (@pair A B a b)) (@snd A B (@pair A B a b))).
+Proof.
+  intros.
+  Fail generalize dependent (a, b).
diff --git a/test-suite/bugs/closed/4527.v b/test-suite/bugs/closed/4527.v
new file mode 100644
index 000000000..08628377f
--- /dev/null
+++ b/test-suite/bugs/closed/4527.v
@@ -0,0 +1,267 @@
+(* -*- mode: coq; coq-prog-args: ("-emacs" "-nois" "-indices-matter" "-R" "." "Top" "-top" "bug_bad_univ_length_01") -*- *)
+(* File reduced by coq-bug-finder from original input, then from 1199 lines to 
+430 lines, then from 444 lines to 430 lines, then from 964 lines to 255 lines, 
+then from 269 lines to 255 lines *)
+(* coqc version 8.5 (January 2016) compiled on Jan 23 2016 16:15:22 with OCaml 
+4.01.0
+   coqtop version 8.5 (January 2016) *)
+Inductive False := .
+Axiom proof_admitted : False.
+Tactic Notation "admit" := case proof_admitted.
+Require Coq.Init.Datatypes.
+
+Import Coq.Init.Notations.
+
+Global Set Universe Polymorphism.
+
+Notation "A -> B" := (forall (_ : A), B) : type_scope.
+
+Inductive True : Type :=
+  I : True.
+Module Export Datatypes.
+
+Set Implicit Arguments.
+Notation nat := Coq.Init.Datatypes.nat.
+Notation S := Coq.Init.Datatypes.S.
+
+Record prod (A B : Type) := pair { fst : A ; snd : B }.
+
+Notation "x * y" := (prod x y) : type_scope.
+
+Open Scope nat_scope.
+
+End Datatypes.
+Module Export Specif.
+
+Set Implicit Arguments.
+
+Record sig {A} (P : A -> Type) := exist { proj1_sig : A ; proj2_sig : P 
+proj1_sig }.
+
+Notation sigT := sig (only parsing).
+
+Notation "{ x : A  & P }" := (sigT (fun x:A => P)) : type_scope.
+
+Notation projT1 := proj1_sig (only parsing).
+Notation projT2 := proj2_sig (only parsing).
+
+End Specif.
+Definition Type1@{i} := Eval hnf in let gt := (Set : Type@{i}) in Type@{i}.
+
+Definition Type2@{i j} := Eval hnf in let gt := (Type1@{j} : Type@{i}) in 
+Type@{i}.
+
+Definition Type2le@{i j} := Eval hnf in let gt := (Set : Type@{i}) in
+                                        let ge := ((fun x => x) : Type1@{j} -> 
+Type@{i}) in Type@{i}.
+
+Notation idmap := (fun x => x).
+Delimit Scope function_scope with function.
+Delimit Scope path_scope with path.
+Delimit Scope fibration_scope with fibration.
+Open Scope fibration_scope.
+Open Scope function_scope.
+
+Notation pr1 := projT1.
+Notation pr2 := projT2.
+
+Notation "x .1" := (pr1 x) (at level 3, format "x '.1'") : fibration_scope.
+Notation "x .2" := (pr2 x) (at level 3, format "x '.2'") : fibration_scope.
+
+Notation compose := (fun g f x => g (f x)).
+
+Notation "g 'o' f" := (compose g%function f%function) (at level 40, left 
+associativity) : function_scope.
+
+Inductive paths {A : Type} (a : A) : A -> Type :=
+  idpath : paths a a.
+
+Arguments idpath {A a} , [A] a.
+
+Notation "x = y :> A" := (@paths A x y) : type_scope.
+Notation "x = y" := (x = y :>_) : type_scope.
+
+Definition inverse {A : Type} {x y : A} (p : x = y) : y = x
+  := match p with idpath => idpath end.
+
+Definition concat {A : Type} {x y z : A} (p : x = y) (q : y = z) : x = z :=
+  match p, q with idpath, idpath => idpath end.
+
+Notation "p @ q" := (concat p%path q%path) (at level 20) : path_scope.
+
+Notation "p ^" := (inverse p%path) (at level 3, format "p '^'") : path_scope.
+
+Definition ap {A B:Type} (f:A -> B) {x y:A} (p:x = y) : f x = f y
+  := match p with idpath => idpath end.
+
+Definition pointwise_paths {A} {P:A->Type} (f g:forall x:A, P x)
+  := forall x:A, f x = g x.
+
+Notation "f == g" := (pointwise_paths f g) (at level 70, no associativity) : 
+type_scope.
+
+Definition Sect {A B : Type} (s : A -> B) (r : B -> A) :=
+  forall x : A, r (s x) = x.
+
+Class IsEquiv {A B : Type} (f : A -> B) := BuildIsEquiv {
+  equiv_inv : B -> A ;
+  eisretr : Sect equiv_inv f;
+  eissect : Sect f equiv_inv;
+  eisadj : forall x : A, eisretr (f x) = ap f (eissect x)
+}.
+
+Arguments eisretr {A B}%type_scope f%function_scope {_} _.
+Arguments eissect {A B}%type_scope f%function_scope {_} _.
+
+Notation "f ^-1" := (@equiv_inv _ _ f _) (at level 3, format "f '^-1'") : 
+function_scope.
+
+Inductive Unit : Type1 :=
+    tt : Unit.
+
+Local Open Scope path_scope.
+
+Section EquivInverse.
+
+  Context {A B : Type} (f : A -> B) {feq : IsEquiv f}.
+
+  Theorem other_adj (b : B) : eissect f (f^-1 b) = ap f^-1 (eisretr f b).
+admit.
+Defined.
+
+  Global Instance isequiv_inverse : IsEquiv f^-1 | 10000
+    := BuildIsEquiv B A f^-1 f (eissect f) (eisretr f) other_adj.
+End EquivInverse.
+
+Section Adjointify.
+
+  Context {A B : Type} (f : A -> B) (g : B -> A).
+  Context (isretr : Sect g f) (issect : Sect f g).
+
+  Let issect' := fun x =>
+    ap g (ap f (issect x)^)  @  ap g (isretr (f x))  @  issect x.
+
+  Let is_adjoint' (a : A) : isretr (f a) = ap f (issect' a).
+admit.
+Defined.
+
+  Definition isequiv_adjointify : IsEquiv f
+    := BuildIsEquiv A B f g isretr issect' is_adjoint'.
+
+End Adjointify.
+
+  Definition ExtensionAlong {A B : Type} (f : A -> B)
+             (P : B -> Type) (d : forall x:A, P (f x))
+    := { s : forall y:B, P y & forall x:A, s (f x) = d x }.
+
+  Fixpoint ExtendableAlong@{i j k l}
+           (n : nat) {A : Type@{i}} {B : Type@{j}}
+           (f : A -> B) (C : B -> Type@{k}) : Type@{l}
+    := match n with
+         | 0 => Unit@{l}
+         | S n => (forall (g : forall a, C (f a)),
+                     ExtensionAlong@{i j k l l} f C g) *
+                  forall (h k : forall b, C b),
+                    ExtendableAlong n f (fun b => h b = k b)
+       end.
+
+  Definition ooExtendableAlong@{i j k l}
+             {A : Type@{i}} {B : Type@{j}}
+             (f : A -> B) (C : B -> Type@{k}) : Type@{l}
+    := forall n, ExtendableAlong@{i j k l} n f C.
+
+Module Type ReflectiveSubuniverses.
+
+  Parameter ReflectiveSubuniverse@{u a} : Type2@{u a}.
+
+  Parameter O_reflector@{u a i} : forall (O : ReflectiveSubuniverse@{u a}),
+                            Type2le@{i a} -> Type2le@{i a}.
+
+  Parameter In@{u a i} : forall (O : ReflectiveSubuniverse@{u a}),
+                   Type2le@{i a} -> Type2le@{i a}.
+
+  Parameter O_inO@{u a i} : forall (O : ReflectiveSubuniverse@{u a}) (T : 
+Type@{i}),
+                               In@{u a i} O (O_reflector@{u a i} O T).
+
+  Parameter to@{u a i} : forall (O : ReflectiveSubuniverse@{u a}) (T : 
+Type@{i}),
+                   T -> O_reflector@{u a i} O T.
+
+  Parameter inO_equiv_inO@{u a i j k} :
+      forall (O : ReflectiveSubuniverse@{u a}) (T : Type@{i}) (U : Type@{j})
+             (T_inO : In@{u a i} O T) (f : T -> U) (feq : IsEquiv f),
+
+        let gei := ((fun x => x) : Type@{i} -> Type@{k}) in
+        let gej := ((fun x => x) : Type@{j} -> Type@{k}) in
+        In@{u a j} O U.
+
+  Parameter extendable_to_O@{u a i j k}
+  : forall (O : ReflectiveSubuniverse@{u a}) {P : Type2le@{i a}} {Q : 
+Type2le@{j a}} {Q_inO : In@{u a j} O Q},
+      ooExtendableAlong@{i i j k} (to O P) (fun _ => Q).
+
+End ReflectiveSubuniverses.
+
+Module ReflectiveSubuniverses_Theory (Os : ReflectiveSubuniverses).
+Export Os.
+
+Existing Class In.
+
+  Coercion O_reflector : ReflectiveSubuniverse >-> Funclass.
+
+Arguments inO_equiv_inO {O} T {U} {_} f {_}.
+Global Existing Instance O_inO.
+
+Section ORecursion.
+  Context {O : ReflectiveSubuniverse}.
+
+  Definition O_indpaths {P Q : Type} {Q_inO : In O Q}
+             (g h : O P -> Q) (p : g o to O P == h o to O P)
+  : g == h
+  := (fst (snd (extendable_to_O O 2) g h) p).1.
+
+  Definition O_indpaths_beta {P Q : Type} {Q_inO : In O Q}
+             (g h : O P -> Q) (p : g o (to O P) == h o (to O P)) (x : P)
+  : O_indpaths g h p (to O P x) = p x
+  := (fst (snd (extendable_to_O O 2) g h) p).2 x.
+
+End ORecursion.
+
+Section Reflective_Subuniverse.
+  Universes Ou Oa.
+  Context (O : ReflectiveSubuniverse@{Ou Oa}).
+
+    Definition inO_isequiv_to_O (T:Type)
+    : IsEquiv (to O T) -> In O T
+    := fun _ => inO_equiv_inO (O T) (to O T)^-1.
+
+    Definition inO_to_O_retract (T:Type) (mu : O T -> T)
+    : Sect (to O T) mu -> In O T.
+    Proof.
+      unfold Sect; intros H.
+      apply inO_isequiv_to_O.
+      apply isequiv_adjointify with (g:=mu).
+      -
+ refine (O_indpaths (to O T o mu) idmap _).
+        intros x; exact (ap (to O T) (H x)).
+      -
+ exact H.
+    Defined.
+
+    Definition inO_paths@{i} (S : Type@{i}) {S_inO : In@{Ou Oa i} O S} (x y : 
+S)    : In@{Ou Oa i} O (x=y).
+    Proof.
+      simple refine (inO_to_O_retract@{i} _ _ _); intro u.
+      -
+ assert (p : (fun _ : O (x=y) => x) == (fun _=> y)).
+        {
+ refine (O_indpaths _ _ _); simpl.
+          intro v; exact v.
+}
+        exact (p u).
+      -
+ hnf.
+        rewrite O_indpaths_beta; reflexivity.
+    Qed.
+    Check inO_paths@{Type}.
diff --git a/test-suite/bugs/closed/4529.v b/test-suite/bugs/closed/4529.v
new file mode 100644
index 000000000..8b3c24fec
--- /dev/null
+++ b/test-suite/bugs/closed/4529.v
@@ -0,0 +1,45 @@
+(* File reduced by coq-bug-finder from original input, then from 1334 lines to 1518 lines, then from 849 lines to 59 lines *)
+(* coqc version 8.5 (January 2016) compiled on Jan 22 2016 18:20:47 with OCaml 4.02.3
+   coqtop version r-schnelltop:/home/r/src/coq/coq,(HEAD detached at V8.5) (5e23fb90b39dfa014ae5c4fb46eb713cca09dbff) *)
+Require Coq.Setoids.Setoid.
+Import Coq.Setoids.Setoid.
+
+Class Equiv A := equiv: relation A.
+Infix "≡" := equiv (at level 70, no associativity).
+Notation "(≡)" := equiv (only parsing).
+
+(* If I remove this line, everything compiles. *)
+Set Primitive Projections.
+
+Class Dist A := dist : nat -> relation A.
+Notation "x ={ n }= y" := (dist n x y)
+  (at level 70, n at next level, format "x  ={ n }=  y").
+
+Record CofeMixin A `{Equiv A, Dist A} := {
+  mixin_equiv_dist x y : x ≡ y <-> forall n, x ={n}= y;
+  mixin_dist_equivalence n : Equivalence (dist n);
+}.
+
+Structure cofeT := CofeT {
+  cofe_car :> Type;
+  cofe_equiv : Equiv cofe_car;
+  cofe_dist : Dist cofe_car;
+  cofe_mixin : CofeMixin cofe_car
+}.
+Existing Instances cofe_equiv cofe_dist.
+Arguments cofe_car : simpl never.
+
+Section cofe_mixin.
+  Context {A : cofeT}.
+  Implicit Types x y : A.
+  Lemma equiv_dist x y : x ≡ y <-> forall n, x ={n}= y.
+Admitted.
+End cofe_mixin.
+  Context {A : cofeT}.
+  Global Instance cofe_equivalence : Equivalence ((≡) : relation A).
+  Proof.
+    split.
+    *
+ intros x.
+apply equiv_dist.
+
diff --git a/test-suite/bugs/closed/4544.v b/test-suite/bugs/closed/4544.v
index 048f31ce3..da140c931 100644
--- a/test-suite/bugs/closed/4544.v
+++ b/test-suite/bugs/closed/4544.v
@@ -652,7 +652,7 @@ Defined.
 
   Definition ReflectiveSubuniverse := Modality.
 
-  Definition O_reflector := O_reflector.
+  Definition O_reflector@{u a i} := O_reflector@{u a i}.
 
   Definition In@{u a i} : forall (O : ReflectiveSubuniverse@{u a}),
                    Type2le@{i a} -> Type2le@{i a}
@@ -660,7 +660,7 @@ Defined.
   Definition O_inO@{u a i} : forall (O : ReflectiveSubuniverse@{u a}) (T : Type@{i}),
                                In@{u a i} O (O_reflector@{u a i} O T)
     := O_inO@{u a i}.
-  Definition to := to.
+  Definition to@{u a i} := to@{u a i}.
   Definition inO_equiv_inO@{u a i j k} :
       forall (O : ReflectiveSubuniverse@{u a}) (T : Type@{i}) (U : Type@{j})
              (T_inO : In@{u a i} O T) (f : T -> U) (feq : IsEquiv f),
diff --git a/test-suite/bugs/closed/4622.v b/test-suite/bugs/closed/4622.v
new file mode 100644
index 000000000..ffa478cb8
--- /dev/null
+++ b/test-suite/bugs/closed/4622.v
@@ -0,0 +1,24 @@
+Set Primitive Projections.
+
+Record foo : Type := bar { x : unit }.
+
+Goal forall t u, bar t = bar u -> t = u.
+Proof.
+  intros.
+  injection H.
+  trivial.
+Qed.
+(* Was: Error: Pattern-matching expression on an object of inductive type foo has invalid information. *)
+
+(** Dependent pattern-matching is ok on this one as it has eta *)
+Definition baz (x : foo) :=
+  match x as x' return x' = x' with
+  | bar u => eq_refl
+  end.
+
+Inductive foo' : Type := bar' {x' : unit; y: foo'}.
+(** Dependent pattern-matching is not ok on this one *)
+Fail Definition baz' (x : foo') :=
+  match x as x' return x' = x' with
+  | bar' u y => eq_refl
+  end.
diff --git a/test-suite/bugs/closed/4644.v b/test-suite/bugs/closed/4644.v
new file mode 100644
index 000000000..f09b27c2b
--- /dev/null
+++ b/test-suite/bugs/closed/4644.v
@@ -0,0 +1,52 @@
+(* Testing a regression of unification in 8.5 in problems of the form
+   "match ?y with ... end = ?x args" *)
+
+Lemma foo : exists b, forall a, match a with tt => tt end = b a.
+Proof.
+eexists. intro.
+refine (_ : _ = match _ with tt => _ end).
+refine eq_refl.
+Qed.
+
+(**********************************************************************)
+
+Axiom proof_admitted : False.
+Tactic Notation "admit" := case proof_admitted.
+Require Export Coq.Classes.Morphisms.
+Require Import Coq.Lists.List.
+
+Global Set Implicit Arguments.
+
+Definition list_caset A (P : list A -> Type) (N : P nil) (C : forall x xs, P (x::xs))
+           ls
+  : P ls
+  := match ls with
+     | nil => N
+     | x::xs => C x xs
+     end.
+
+Axiom list_caset_Proper'
+  : forall {A P},
+    Proper (eq
+              ==> pointwise_relation _ (pointwise_relation _ eq)
+              ==> eq
+              ==> eq)
+           (@list_caset A (fun _ => P)).
+Goal forall (T T' : Set) (a3 : list T), exists y2, forall (a4 : T' -> bool),
+        match a3 with
+        | nil => 0
+        | (_ :: _)%list => 1
+        end = y2 a4.
+  clear; eexists; intros.
+  reflexivity. Undo.
+  Local Ltac t :=
+    lazymatch goal with
+    | [ |- match ?v with nil => ?N | cons x xs => @?C x xs end = _ :> ?P ]
+      => let T := type of v in
+         let A := match (eval hnf in T) with list ?A => A end in
+         refine (@list_caset_Proper' A P _ _ _ _ _ _ _ _ _
+                 : @list_caset A (fun _ => P) N C v = match _ with nil => _ | cons x xs => _ end)
+    end.
+  (etransitivity; [ t | reflexivity ]) || fail 0 "too early".
+  Undo.
+  t.
diff --git a/test-suite/bugs/closed/4653.v b/test-suite/bugs/closed/4653.v
new file mode 100644
index 000000000..4514342c5
--- /dev/null
+++ b/test-suite/bugs/closed/4653.v
@@ -0,0 +1,3 @@
+Definition T := Type.
+Module Type S. Parameter foo : let A := T in True. End S.
+Module M <: S. Lemma foo (A := T) : True. Proof I. End M.
diff --git a/test-suite/bugs/closed/4661.v b/test-suite/bugs/closed/4661.v
new file mode 100644
index 000000000..03d2350a6
--- /dev/null
+++ b/test-suite/bugs/closed/4661.v
@@ -0,0 +1,10 @@
+Module Type Test.
+  Parameter t : Type.
+End Test.
+
+Module Type Func (T:Test).
+  Parameter x : Type.
+End Func.
+
+Module Shortest_path (T : Test).
+Print Func.
diff --git a/test-suite/bugs/closed/4673.v b/test-suite/bugs/closed/4673.v
new file mode 100644
index 000000000..1ae508185
--- /dev/null
+++ b/test-suite/bugs/closed/4673.v
@@ -0,0 +1,57 @@
+(* -*- mode: coq; coq-prog-args: ("-emacs" "-R" "." "Fiat" "-top" "BooleanRecognizerOptimized" "-R" "." "Top") -*- *)
+(* File reduced by coq-bug-finder from original input, then from 2407 lines to 22 lines, then from 528 lines to 35 lines, then from 331 lines to 42 lines, then from 56 lines to 42 lines, then from 63 lines to 46 lines, then from 60 lines to 46 lines *) (* coqc version 8.5 (February 2016) compiled on Feb 21 2016 15:26:16 with OCaml 4.02.3
+   coqtop version 8.5 (February 2016) *)
+Axiom proof_admitted : False.
+Tactic Notation "admit" := case proof_admitted.
+Require Coq.Lists.List.
+Import Coq.Lists.List.
+Import Coq.Classes.Morphisms.
+
+Definition list_caset A (P : list A -> Type) (N : P nil) (C : forall x xs, P (x::xs))
+           ls
+  : P ls
+  := match ls with
+     | nil => N
+     | x::xs => C x xs
+     end.
+
+Global Instance list_caset_Proper' {A P}
+  : Proper (eq
+              ==> pointwise_relation _ (pointwise_relation _ eq)
+              ==> eq
+              ==> eq)
+           (@list_caset A (fun _ => P)).
+admit.
+Defined.
+
+Global Instance list_caset_Proper'' {A P}
+  : (Proper (eq ==> pointwise_relation _ (pointwise_relation _ eq) ==> forall_relation (fun _ => eq))
+   (list_caset A (fun _ => P))).
+Admitted.
+
+Goal    forall (Char : Type) (P : forall _ : list bool, Prop) (l : list bool) (l0 : forall _ : forall _ : Char, bool, list bool)
+               
+               (T : Type) (T0 : forall _ : T, Type) (t : T),
+    
+    let predata := t in
+
+    forall (splitdata : T0 predata) (l5 : forall _ : T0 t, list nat) (T1 : Type) (b : forall (_ : T1) (_ : Char), bool)
+           
+           (T2 : Type) (a11 : T2) (xs : list T2) (T3 : Type) (i0 : T3) (P0 : Set) (b1 : forall (_ : nat) (_ : P0), bool)
+           
+           (l2 : forall (_ : forall _ : T1, list bool) (_ : forall _ : P0, list bool) (_ : T2), list bool)
+           
+           (l1 : forall (_ : forall _ : forall _ : Char, bool, list bool) (_ : forall _ : P0, list bool) (_ : T3), list bool)
+           
+           (_ : forall NT : forall _ : P0, list bool, @eq (list bool) (l1 l0 NT i0) (l2 (fun f : T1 => l0 (b f)) NT a11)),
+      
+      P
+        (@list_caset T2 (fun _ : list T2 => list bool) l
+                     (fun (_ : T2) (_ : list T2) => l1 l0 (fun a9 : P0 => @map nat bool (fun x0 : nat => b1 x0 a9) (l5 splitdata)) i0
+) xs).
+  intros.
+  subst predata;
+  let H := match goal with H : forall _, _ = _ |- _ => H end in
+  setoid_rewrite H || fail 0 "too early".
+  Undo.
+  setoid_rewrite H.
diff --git a/test-suite/bugs/closed/4679.v b/test-suite/bugs/closed/4679.v
new file mode 100644
index 000000000..c94fa31a9
--- /dev/null
+++ b/test-suite/bugs/closed/4679.v
@@ -0,0 +1,18 @@
+Require Import Coq.Setoids.Setoid.
+Goal forall (T : nat -> Set -> Set) (U : Set)
+            (H : forall n : nat, T n (match n with
+                                      | 0 => fun x => x
+                                      | S _ => fun x => x
+                                      end (nat = nat)) = U),
+    T 0 (nat = nat) = U.
+Proof.
+  intros.
+  let H := match goal with H : forall _, eq _ _ |- _ => H end in
+  rewrite H || fail 0 "too early".
+  Undo.
+  let H := match goal with H : forall _, eq _ _ |- _ => H end in
+  setoid_rewrite (H 0) || fail 0 "too early".
+  Undo.
+  setoid_rewrite H. (* Error: Tactic failure: setoid rewrite failed: Nothing to rewrite. *)
+  reflexivity.
+Qed.
\ No newline at end of file
diff --git a/test-suite/bugs/closed/4684.v b/test-suite/bugs/closed/4684.v
new file mode 100644
index 000000000..9c0bed42c
--- /dev/null
+++ b/test-suite/bugs/closed/4684.v
@@ -0,0 +1,32 @@
+(*Suppose a user wants to declare a new list-like notation with support for singletons in both 8.4 and 8.5.  If they use*)
+Require Import Coq.Lists.List.
+Require Import Coq.Vectors.Vector.
+Import ListNotations.
+Import VectorNotations.
+Set Implicit Arguments.
+Inductive mylist T := mynil | mycons (_ : T) (_ : mylist T).
+Arguments mynil {_}, _.
+
+Delimit Scope mylist_scope with mylist.
+Bind Scope mylist_scope with mylist.
+Delimit Scope vector_scope with vector.
+
+Notation " [ ] " := mynil (format "[ ]") : mylist_scope.
+Notation " [ x ] " := (mycons x mynil) : mylist_scope.
+Notation " [ x ; y ; .. ; z ] " := (mycons x (mycons y .. (mycons z mynil) ..)) : mylist_scope.
+
+Check [ ]%mylist : mylist _.
+Check [ ]%list : list _.
+Check []%vector : Vector.t _ _.
+Check [ _ ]%mylist : mylist _.
+Check [ _ ]%list : list _.
+Check [ _ ]%vector : Vector.t _ _.
+Check [ _ ; _ ]%list : list _.
+Check [ _ ; _ ]%vector : Vector.t _ _.
+Check [ _ ; _ ]%mylist : mylist _.
+Check [ _ ; _ ; _ ]%list : list _.
+Check [ _ ; _ ; _ ]%vector : Vector.t _ _.
+Check [ _ ; _ ; _ ]%mylist : mylist _.
+Check [ _ ; _ ; _ ; _ ]%list : list _.
+Check [ _ ; _ ; _ ; _ ]%vector : Vector.t _ _.
+Check [ _ ; _ ; _ ; _ ]%mylist : mylist _.
diff --git a/test-suite/bugs/closed/4708.v b/test-suite/bugs/closed/4708.v
new file mode 100644
index 000000000..ad2e58100
--- /dev/null
+++ b/test-suite/bugs/closed/4708.v
@@ -0,0 +1,8 @@
+(*Doc, it hurts when I poke myself.*)
+
+Notation "'" := 1. (* was:
+Setting notation at level 0.
+Toplevel input, characters 0-18:
+> Notation "'" := 1.
+> ^^^^^^^^^^^^^^^^^^
+Anomaly: Uncaught exception Invalid_argument("index out of bounds"). Please report. *)
diff --git a/test-suite/bugs/closed/4718.v b/test-suite/bugs/closed/4718.v
new file mode 100644
index 000000000..12a4e8fc1
--- /dev/null
+++ b/test-suite/bugs/closed/4718.v
@@ -0,0 +1,15 @@
+(*Congruence is weaker than reflexivity when it comes to higher level than necessary equalities:*)
+
+Goal @eq Set nat nat.
+congruence.
+Qed.
+
+Goal @eq Type nat nat.
+congruence. (*bug*)
+Qed.
+
+Variable T : Type.
+
+Goal @eq Type T T.
+congruence.
+Qed.
diff --git a/test-suite/bugs/closed/4722.v b/test-suite/bugs/closed/4722.v
new file mode 100644
index 000000000..f047624c8
--- /dev/null
+++ b/test-suite/bugs/closed/4722.v
@@ -0,0 +1 @@
+(* -*- coq-prog-args: ("-emacs" "-R" "4722" "Foo") -*- *)
diff --git a/test-suite/bugs/closed/4722/tata b/test-suite/bugs/closed/4722/tata
new file mode 120000
index 000000000..b38e66e75
--- /dev/null
+++ b/test-suite/bugs/closed/4722/tata
@@ -0,0 +1 @@
+toto
\ No newline at end of file
diff --git a/test-suite/bugs/closed/4723.v b/test-suite/bugs/closed/4723.v
new file mode 100644
index 000000000..888481210
--- /dev/null
+++ b/test-suite/bugs/closed/4723.v
@@ -0,0 +1,28 @@
+
+Require Coq.Program.Tactics.
+
+Record Matrix (m n : nat).
+
+Definition kp {m n p q: nat} (A: Matrix m n) (B: Matrix p q):
+  Matrix (m*p) (n*q). Admitted.
+
+Fail Program Fact kp_assoc
+        (xr xc yr yc zr zc: nat)
+        (x: Matrix xr xc) (y: Matrix yr yc) (z: Matrix zr zc):
+  kp x (kp y z) = kp (kp x y) z.
+
+Ltac Obligation Tactic := admit.
+Fail Program Fact kp_assoc
+        (xr xc yr yc zr zc: nat)
+        (x: Matrix xr xc) (y: Matrix yr yc) (z: Matrix zr zc):
+  kp x (kp y z) = kp (kp x y) z.
+
+Axiom cheat : forall {A}, A.
+Obligation Tactic := apply cheat.
+
+Program Fact kp_assoc
+        (xr xc yr yc zr zc: nat)
+        (x: Matrix xr xc) (y: Matrix yr yc) (z: Matrix zr zc):
+  kp x (kp y z) = kp (kp x y) z.
+admit.
+Admitted.
\ No newline at end of file
diff --git a/test-suite/bugs/closed/4725.v b/test-suite/bugs/closed/4725.v
new file mode 100644
index 000000000..fd5e0fb60
--- /dev/null
+++ b/test-suite/bugs/closed/4725.v
@@ -0,0 +1,38 @@
+Require Import EquivDec Equivalence List Program.
+Require Import Relation_Definitions.
+Import ListNotations.
+Generalizable All Variables.
+
+Fixpoint removeV `{eqDecV : @EqDec V eqV equivV}`(x : V) (l : list V) : list V
+:=
+  match l with
+  | nil => nil
+  | y::tl => if (equiv_dec x y) then removeV x tl else y::(removeV x tl)
+  end.
+
+Lemma remove_le {V:Type}{eqV:relation V}{equivV:@Equivalence V eqV}{eqDecV :
+@EqDec V eqV equivV} (xs : list V) (x : V) :
+  length (removeV x xs) < length (x :: xs).
+  Proof. Admitted.
+
+(* Function version *)
+Set Printing Universes.
+
+Require Import Recdef.
+
+Function nubV {V:Type}{eqV:relation V}{equivV:@Equivalence V eqV}{eqDecV :
+@EqDec V eqV equivV} (l : list V) { measure length l} :=
+    match l with
+      | nil => nil
+      | x::xs => x :: @nubV V eqV equivV eqDecV (removeV x xs)
+    end.
+Proof. intros. apply remove_le. Qed.
+
+(* Program version *)
+
+Program Fixpoint nubV `{eqDecV : @EqDec V eqV equivV} (l : list V)
+        {  measure (@length V l) lt } :=
+    match l with
+      | nil => nil
+      | x::xs => x :: @nubV V eqV equivV eqDecV (removeV x xs) _
+    end.
diff --git a/test-suite/bugs/closed/4726.v b/test-suite/bugs/closed/4726.v
new file mode 100644
index 000000000..0037b6fde
--- /dev/null
+++ b/test-suite/bugs/closed/4726.v
@@ -0,0 +1,19 @@
+Set Universe Polymorphism.
+
+Definition le@{i j} : Type@{j} :=
+  (fun A : Type@{j} => A)
+  (unit : Type@{i}).  
+Definition eq@{i j} : Type@{j} := let x := le@{i j} in le@{j i}.
+
+Record Inj@{i j} (A : Type@{i}) (B : Type@{j}) : Type@{j} :=
+  { inj : A }.
+
+Monomorphic Universe u1.
+Let ty1 : Type@{u1} := Set.
+Check Inj@{Set u1}.
+(* Would fail with univ inconsistency if the universe was minimized *)
+
+Record Inj'@{i j} (A : Type@{i}) (B : Type@{j}) : Type@{j} :=
+  { inj' : A; foo : Type@{j} := eq@{i j} }.
+Fail Check Inj'@{Set u1}. (* Do not drop constraint i = j *)
+Check Inj'@{Set Set}.
diff --git a/test-suite/bugs/closed/4727.v b/test-suite/bugs/closed/4727.v
new file mode 100644
index 000000000..3854bbffd
--- /dev/null
+++ b/test-suite/bugs/closed/4727.v
@@ -0,0 +1,10 @@
+(* -*- coq-prog-args: ("-emacs" "-compat" "8.4") -*- *)
+Goal forall (P : Set) (l : P) (P0 : Set) (w w0 : P0) (T : Type) (a : P * T) (o : P -> option P0),
+    (forall (l1 l2 : P) (w1 : P0), o l1 = Some w1 -> o l2 = Some w1 -> l1 = l2) ->
+    o l = Some w -> o (fst a) = Some w0 -> {w = w0} + {w <> w0} -> False.
+Proof.
+  clear; intros ???????? inj H0 H1 H2.
+  destruct H2; intuition subst.
+  eapply inj in H1; [ | eauto ].
+  progress subst. (* should succeed, used to not succeed *)
+Abort.
diff --git a/test-suite/bugs/closed/4733.v b/test-suite/bugs/closed/4733.v
new file mode 100644
index 000000000..a6ebda61c
--- /dev/null
+++ b/test-suite/bugs/closed/4733.v
@@ -0,0 +1,52 @@
+(* -*- coq-prog-args: ("-emacs" "-compat" "8.4") -*- *)
+(*Suppose a user wants to declare a new list-like notation with support for singletons in both 8.4 and 8.5.  If they use*)
+Require Import Coq.Lists.List.
+Require Import Coq.Vectors.Vector.
+Import ListNotations.
+Import VectorNotations.
+Set Implicit Arguments.
+Inductive mylist T := mynil | mycons (_ : T) (_ : mylist T).
+Arguments mynil {_}, _.
+
+Delimit Scope mylist_scope with mylist.
+Bind Scope mylist_scope with mylist.
+Delimit Scope vector_scope with vector.
+
+Notation " [ ] " := mynil (format "[ ]") : mylist_scope.
+Notation " [ x ] " := (mycons x mynil) : mylist_scope.
+Notation " [ x ; .. ; y ] " := (mycons x .. (mycons y mynil) ..) : mylist_scope.
+
+(** All of these should work fine in -compat 8.4 mode, just as they do in Coq 8.4.  There needs to be a way to specify notations above so that all of these [Check]s go through in both 8.4 and 8.5 *)
+Check [ ]%mylist : mylist _.
+Check [ ]%list : list _.
+Check []%vector : Vector.t _ _.
+Check [ _ ]%mylist : mylist _.
+Check [ _ ]%list : list _.
+Check [ _ ]%vector : Vector.t _ _.
+Check [ _ ; _ ]%list : list _.
+Check [ _ ; _ ]%vector : Vector.t _ _.
+Check [ _ ; _ ]%mylist : mylist _.
+Check [ _ ; _ ; _ ]%list : list _.
+Check [ _ ; _ ; _ ]%vector : Vector.t _ _.
+Check [ _ ; _ ; _ ]%mylist : mylist _.
+Check [ _ ; _ ; _ ; _ ]%list : list _.
+Check [ _ ; _ ; _ ; _ ]%vector : Vector.t _ _.
+Check [ _ ; _ ; _ ; _ ]%mylist : mylist _.
+
+Notation " [ x ; y ; .. ; z ] " := (mycons x (mycons y .. (mycons z mynil) ..)) : mylist_scope.
+(* Now these all work, but not so in 8.4.  If we get the ability to remove notations, this section can also just be removed. *)
+Check [ ]%mylist : mylist _.
+Check [ ]%list : list _.
+Check []%vector : Vector.t _ _.
+Check [ _ ]%mylist : mylist _.
+Check [ _ ]%list : list _.
+Check [ _ ]%vector : Vector.t _ _.
+Check [ _ ; _ ]%list : list _.
+Check [ _ ; _ ]%vector : Vector.t _ _.
+Check [ _ ; _ ]%mylist : mylist _.
+Check [ _ ; _ ; _ ]%list : list _.
+Check [ _ ; _ ; _ ]%vector : Vector.t _ _.
+Check [ _ ; _ ; _ ]%mylist : mylist _.
+Check [ _ ; _ ; _ ; _ ]%list : list _.
+Check [ _ ; _ ; _ ; _ ]%vector : Vector.t _ _.
+Check [ _ ; _ ; _ ; _ ]%mylist : mylist _.
diff --git a/test-suite/bugs/closed/4745.v b/test-suite/bugs/closed/4745.v
new file mode 100644
index 000000000..c090125e6
--- /dev/null
+++ b/test-suite/bugs/closed/4745.v
@@ -0,0 +1,35 @@
+(*I get an Anomaly in the following code.
+
+```*)
+Require Vector.
+
+Module M.
+  Lemma Vector_map_map :
+    forall A B C (f : A -> B) (g : B -> C) n (v : Vector.t A n),
+      Vector.map g (Vector.map f v) = Vector.map (fun a => g (f a)) v.
+  Proof.
+    induction v; simpl; auto using f_equal.
+  Qed.
+
+  Lemma Vector_map_map_transparent :
+    forall A B C (f : A -> B) (g : B -> C) n (v : Vector.t A n),
+      Vector.map g (Vector.map f v) = Vector.map (fun a => g (f a)) v.
+  Proof.
+    induction v; simpl; auto using f_equal.
+  Defined.
+  (* Anomaly: constant not found in kind_of_head: Coq.Vectors.Vector.t_ind. Please report. *)
+
+  (* strangely, explicitly passing the principle to induction works *)
+  Lemma Vector_map_map_transparent' :
+    forall A B C (f : A -> B) (g : B -> C) n (v : Vector.t A n),
+      Vector.map g (Vector.map f v) = Vector.map (fun a => g (f a)) v.
+  Proof.
+    induction v using Vector.t_ind; simpl; auto using f_equal.
+  Defined.
+End M.
+(*```
+
+Changing any of the following things eliminates the Anomaly
+   * moving the lemma out of the module M to the top level
+   * proving the lemma as a Fixpoint instead of using induction
+   * proving the analogous lemma on lists instead of vectors*)
diff --git a/test-suite/bugs/closed/4754.v b/test-suite/bugs/closed/4754.v
new file mode 100644
index 000000000..5bb3cd1be
--- /dev/null
+++ b/test-suite/bugs/closed/4754.v
@@ -0,0 +1,35 @@
+
+Require Import Coq.Setoids.Setoid Coq.Classes.Morphisms.
+Definition f (v : option nat) := match v with
+                                 | Some k => Some k
+                                 | None => None
+                                 end.
+
+Axioms F G : (option nat -> option nat) -> Prop.
+Axiom FG : forall f, f None = None -> F f = G f.
+
+Axiom admit : forall {T}, T.
+
+Existing Instance eq_Reflexive.
+
+Global Instance foo (A := nat)
+  : Proper ((pointwise_relation _ eq)
+              ==> eq ==> forall_relation (fun _ => Basics.flip Basics.impl))
+           (@option_rect A (fun _ => Prop)) | 0.
+exact admit.
+Qed.
+
+Global Instance bar (A := nat)
+  : Proper ((pointwise_relation _ eq)
+              ==> eq ==> eq ==> Basics.flip Basics.impl)
+           (@option_rect A (fun _ => Prop)) | 0.
+exact admit.
+Qed.
+
+Goal forall k, option_rect (fun _ => Prop) (fun v : nat => v = v /\ F f) True k.
+Proof.
+  intro.
+  pose proof (_ : (Proper (_ ==> eq ==> _) and)).
+  setoid_rewrite (FG _ _); [ | reflexivity.. ].
+  Undo.
+  setoid_rewrite (FG _ eq_refl). (* Error: Tactic failure: setoid rewrite failed: Nothing to rewrite. in 8.5 *) Admitted.
\ No newline at end of file
diff --git a/test-suite/bugs/closed/4762.v b/test-suite/bugs/closed/4762.v
new file mode 100644
index 000000000..7a87b07a8
--- /dev/null
+++ b/test-suite/bugs/closed/4762.v
@@ -0,0 +1,24 @@
+Inductive myand (P Q : Prop) := myconj : P -> Q -> myand P Q.
+
+Lemma foo P Q R : R = myand P Q -> P -> Q -> R.
+Proof. intros ->; constructor; auto. Qed.
+
+Hint Extern 0 (myand _ _) => eapply foo; [reflexivity| |] : test1.
+
+Goal forall P Q R : Prop, P -> Q -> R -> myand P (myand Q R).
+Proof.
+  intros.
+  eauto with test1.
+Qed.
+
+Hint Extern 0 =>
+  match goal with
+  | |- myand _ _ => eapply foo; [reflexivity| |]
+  end : test2.
+
+Goal forall P Q R : Prop, P -> Q -> R -> myand P (myand Q R).
+Proof.
+  intros.
+  eauto with test2. (* works *)
+Qed.
+
diff --git a/test-suite/bugs/closed/4763.v b/test-suite/bugs/closed/4763.v
new file mode 100644
index 000000000..ae8ed0e6e
--- /dev/null
+++ b/test-suite/bugs/closed/4763.v
@@ -0,0 +1,13 @@
+Require Import Coq.Arith.Arith Coq.Classes.Morphisms Coq.Classes.RelationClasses.
+Coercion is_true : bool >-> Sortclass.
+Global Instance: Transitive leb.
+Admitted.
+
+Goal forall x y z, leb x y -> leb y z -> True.
+  intros ??? H H'.
+  lazymatch goal with
+  | [ H : is_true (?R ?x ?y), H' : is_true (?R ?y ?z) |- _ ]
+    => pose proof (transitivity H H' : is_true (R x z))
+  end.
+  exact I.
+Qed.
\ No newline at end of file
diff --git a/test-suite/bugs/closed/4764.v b/test-suite/bugs/closed/4764.v
new file mode 100644
index 000000000..e545cc1b7
--- /dev/null
+++ b/test-suite/bugs/closed/4764.v
@@ -0,0 +1,5 @@
+Notation prop_fun x y := (fun (x : Prop) => y).
+Definition foo := fun (p : Prop) => p.
+Definition bar := fun (_ : Prop) => O.
+Print foo.
+Print bar.
diff --git a/test-suite/bugs/closed/4769.v b/test-suite/bugs/closed/4769.v
new file mode 100644
index 000000000..d87906f31
--- /dev/null
+++ b/test-suite/bugs/closed/4769.v
@@ -0,0 +1,94 @@
+
+(* -*- mode: coq; coq-prog-args: ("-emacs" "-nois" "-R" "." "Top" "-top" "bug_hom_anom_10") -*- *)
+(* File reduced by coq-bug-finder from original input, then from 156 lines to 41 lines, then from 237 lines to 45 lines, then from 163 lines to 66 lines, then from 342 lines to 121 lines, then from 353 lines to 184 lines, then from 343 lines to 255 lines, then from 435 lines to 322 lines, then from 475 lines to 351 lines, then from 442 lines to 377 lines, then from 505 lines to 410 lines, then from 591 lines to 481 lines, then from 596 lines to 535 lines, then from 647 lines to 570 lines, then from 669 lines to 596 lines, then from 687 lines to 620 lines, then from 728 lines to 652 lines, then from 1384 lines to 683 lines, then from 984 lines to 707 lines, then from 1124 lines to 734 lines, then from 775 lines to 738 lines, then from 950 lines to 763 lines, then from 857 lines to 798 lines, then from 983 lines to 752 lines, then from 1598 lines to 859 lines, then from 873 lines to 859 lines, then from 875 lines to 862 lines, then from 901 lines to 863 lines, then from 1047 lines to 865 lines, then from 929 lines to 871 lines, then from 989 lines to 884 lines, then from 900 lines to 884 lines, then from 884 lines to 751 lines, then from 763 lines to 593 lines, then from 482 lines to 232 lines, then from 416 lines to 227 lines, then from 290 lines to 231 lines, then from 348 lines to 235 lines, then from 249 lines to 235 lines, then from 249 lines to 172 lines, then from 186 lines to 172 lines, then from 140 lines to 113 lines, then from 127 lines to 113 lines *) (* coqc version trunk (June 2016) compiled on Jun 2 2016 10:16:20 with OCaml 4.02.3
+   coqtop version trunk (June 2016) *)
+
+Reserved Notation "x -> y" (at level 99, right associativity, y at level 200).
+Reserved Notation "x * y" (at level 40, left associativity).
+Delimit Scope type_scope with type.
+Open Scope type_scope.
+Global Set Universe Polymorphism.
+Notation "A -> B" := (forall (_ : A), B) : type_scope.
+Set Implicit Arguments.
+Global Set Nonrecursive Elimination Schemes.
+Record prod (A B : Type) := pair { fst : A ; snd : B }.
+Notation "x * y" := (prod x y) : type_scope.
+Axiom admit : forall {T}, T.
+Delimit Scope function_scope with function.
+Notation compose := (fun g f x => g (f x)).
+Notation "g 'o' f" := (compose g%function f%function) (at level 40, left associativity) : function_scope.
+Record PreCategory :=
+  Build_PreCategory {
+      object :> Type;
+      morphism : object -> object -> Type;
+      identity : forall x, morphism x x }.
+Bind Scope category_scope with PreCategory.
+Record Functor (C D : PreCategory) := { object_of :> C -> D }.
+Bind Scope functor_scope with Functor.
+Class Isomorphic {C : PreCategory} (s d : C) := {}.
+Definition oppositeC (C : PreCategory) : PreCategory
+  := @Build_PreCategory C (fun s d => morphism C d s) admit.
+Notation "C ^op" := (oppositeC C) (at level 3, format "C '^op'") : category_scope.
+Definition oppositeF C D (F : Functor C D) : Functor C^op D^op
+  := Build_Functor (C^op) (D^op) (object_of F).
+Definition set_cat : PreCategory := @Build_PreCategory Type (fun x y => x -> y) admit.
+Definition prodC (C D : PreCategory) : PreCategory
+  := @Build_PreCategory
+       (C * D)%type
+       (fun s d => (morphism C (fst s) (fst d)
+                    * morphism D (snd s) (snd d))%type)
+       admit.
+Infix "*" := prodC : category_scope.
+Section composition.
+  Variables B C D E : PreCategory.
+  Definition composeF (G : Functor D E) (F : Functor C D) : Functor C E := Build_Functor C E (fun c => G (F c)).
+End composition.
+Infix "o" := composeF : functor_scope.
+Definition fstF {C D} : Functor (C * D) C := admit.
+Definition sndF {C D} : Functor (C * D) D := admit.
+Definition prodF C D D' (F : Functor C D) (F' : Functor C D') : Functor C (D * D') := admit.
+Local Infix "*" := prodF : functor_scope.
+Definition pairF C D C' D' (F : Functor C D) (F' : Functor C' D') : Functor (C * C') (D * D')
+  := (F o fstF) * (F' o sndF).
+Section hom_functor.
+  Variable C : PreCategory.
+  Local Notation obj_of c'c :=
+    ((morphism
+        C
+        (fst (c'c : object (C^op * C)))
+        (snd (c'c : object (C^op * C))))).
+  Definition hom_functor : Functor (C^op * C) set_cat
+    := Build_Functor (C^op * C) set_cat (fun c'c => obj_of c'c).
+End hom_functor.
+Definition identityF C : Functor C C := admit.
+Definition functor_category (C D : PreCategory) : PreCategory
+  := @Build_PreCategory (Functor C D) admit admit.
+Local Notation "C -> D" := (functor_category C D) : category_scope.
+Definition NaturalIsomorphism (C D : PreCategory) F G := @Isomorphic (C -> D) F G.
+
+Section Adjunction.
+  Variables C D : PreCategory.
+  Variable F : Functor C D.
+  Variable G : Functor D C.
+  
+  Record AdjunctionHom :=
+    {
+      mate_of : @NaturalIsomorphism
+                  (prodC (oppositeC C) D)
+                  (@set_cat)
+                  (@composeF
+                     (prodC (oppositeC C) D)
+                     (prodC (oppositeC D) D)
+                     (@set_cat) (@hom_functor D)
+                     (@pairF (oppositeC C)
+                             (oppositeC D) D D
+                             (@oppositeF C D F) (identityF D)))
+                  (@composeF
+                     (prodC (oppositeC C) D)
+                     (prodC (oppositeC C) C)
+                     (@set_cat) (@hom_functor C)
+                     (@pairF (oppositeC C)
+                             (oppositeC C) D C
+                             (identityF (oppositeC C)) G))
+    }.
+End Adjunction.
\ No newline at end of file
diff --git a/test-suite/bugs/closed/4772.v b/test-suite/bugs/closed/4772.v
new file mode 100644
index 000000000..c3109fa31
--- /dev/null
+++ b/test-suite/bugs/closed/4772.v
@@ -0,0 +1,6 @@
+
+Record TruncType := BuildTruncType {
+  trunctype_type : Type
+}.
+
+Fail Arguments BuildTruncType _ _ {_}. (* This should fail *)
diff --git a/test-suite/bugs/closed/4780.v b/test-suite/bugs/closed/4780.v
new file mode 100644
index 000000000..4cec43184
--- /dev/null
+++ b/test-suite/bugs/closed/4780.v
@@ -0,0 +1,106 @@
+(* -*- mode: coq; coq-prog-args: ("-emacs" "-R" "." "Top" "-top" "bug_bad_induction_01") -*- *)
+(* File reduced by coq-bug-finder from original input, then from 1889 lines to 144 lines, then from 158 lines to 144 lines *)
+(* coqc version 8.5pl1 (April 2016) compiled on Apr 18 2016 14:48:5 with OCaml 4.02.3
+   coqtop version 8.5pl1 (April 2016) *)
+Axiom proof_admitted : False.
+Tactic Notation "admit" := abstract case proof_admitted.
+Global Set Universe Polymorphism.
+Global Set Asymmetric Patterns.
+Notation "'exists' x .. y , p" := (sigT (fun x => .. (sigT (fun y => p)) ..))
+  (at level 200, x binder, right associativity,
+   format "'[' 'exists'  '/  ' x  ..  y ,  '/  ' p ']'")
+  : type_scope.
+Definition relation (A : Type) := A -> A -> Type.
+Class Transitive {A} (R : relation A) := transitivity : forall x y z, R x y -> R y z -> R x z.
+Tactic Notation "etransitivity" open_constr(y) :=
+  let R := match goal with |- ?R ?x ?z => constr:(R) end in
+  let x := match goal with |- ?R ?x ?z => constr:(x) end in
+  let z := match goal with |- ?R ?x ?z => constr:(z) end in
+  refine (@transitivity _ R _ x y z _ _).
+Tactic Notation "etransitivity" := etransitivity _.
+Notation "( x ; y )" := (existT _ x y) : fibration_scope.
+Open Scope fibration_scope.
+Notation pr1 := projT1.
+Notation pr2 := projT2.
+Notation "x .1" := (projT1 x) (at level 3) : fibration_scope.
+Notation "x .2" := (projT2 x) (at level 3) : fibration_scope.
+Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a.
+Arguments idpath {A a} , [A] a.
+Arguments paths_rect [A] a P f y p.
+Notation "x = y :> A" := (@paths A x y) : type_scope.
+Notation "x = y" := (x = y :>_) : type_scope.
+Delimit Scope path_scope with path.
+Local Open Scope path_scope.
+Definition concat {A : Type} {x y z : A} (p : x = y) (q : y = z) : x = z :=
+  match p, q with idpath, idpath => idpath end.
+Instance transitive_paths {A} : Transitive (@paths A) | 0 := @concat A.
+Definition inverse {A : Type} {x y : A} (p : x = y) : y = x
+  := match p with idpath => idpath end.
+Notation "1" := idpath : path_scope.
+Notation "p @ q" := (concat p q) (at level 20) : path_scope.
+Notation "p ^" := (inverse p) (at level 3) : path_scope.
+Definition transport {A : Type} (P : A -> Type) {x y : A} (p : x = y) (u : P x) : P y :=
+  match p with idpath => u end.
+Notation "p # x" := (transport _ p x) (right associativity, at level 65, only parsing) : path_scope.
+Definition ap {A B:Type} (f:A -> B) {x y:A} (p:x = y) : f x = f y
+  := match p with idpath => idpath end.
+Definition apD {A:Type} {B:A->Type} (f:forall a:A, B a) {x y:A} (p:x=y):
+  p # (f x) = f y
+  := match p with idpath => idpath end.
+Lemma transport_compose {A B} {x y : A} (P : B -> Type) (f : A -> B)
+  (p : x = y) (z : P (f x))
+  : transport (fun x => P (f x)) p z  =  transport P (ap f p) z.
+admit.
+Defined.
+Local Open Scope path_scope.
+Generalizable Variables X A B C f g n.
+Definition path_sigma_uncurried {A : Type} (P : A -> Type) (u v : sigT P)
+  (pq : {p : u.1 = v.1 &  p # u.2 = v.2})
+  : u = v
+  := match pq with
+       | existT p q =>
+         match u, v return (forall p0 : (u.1 = v.1), (p0 # u.2 = v.2) -> (u=v)) with
+           | (x;y), (x';y') => fun p1 q1 =>
+             match p1 in (_ = x'') return (forall y'', (p1 # y = y'') -> (x;y)=(x'';y'')) with
+               | idpath => fun y' q2 =>
+                 match q2 in (_ = y'') return (x;y) = (x;y'') with
+                   | idpath => 1
+                 end
+             end y' q1
+         end p q
+     end.
+Definition path_sigma {A : Type} (P : A -> Type) (u v : sigT P)
+  (p : u.1 = v.1) (q : p # u.2 = v.2)
+  : u = v
+  := path_sigma_uncurried P u v (p;q).
+Definition projT1_path `{P : A -> Type} {u v : sigT P} (p : u = v)
+  : u.1 = v.1
+  :=
+  ap (@projT1 _ _) p.
+Notation "p ..1" := (projT1_path p) (at level 3) : fibration_scope.
+Definition projT2_path `{P : A -> Type} {u v : sigT P} (p : u = v)
+  : p..1 # u.2 = v.2
+  := (transport_compose P (@projT1 _ _) p u.2)^
+     @ (@apD {x:A & P x} _ (@projT2 _ _) _ _ p).
+Notation "p ..2" := (projT2_path p) (at level 3) : fibration_scope.
+Definition eta_path_sigma_uncurried `{P : A -> Type} {u v : sigT P}
+  (p : u = v)
+  : path_sigma_uncurried _ _ _ (p..1; p..2) = p.
+admit.
+Defined.
+Definition eta_path_sigma `{P : A -> Type} {u v : sigT P} (p : u = v)
+  : path_sigma _ _ _ (p..1) (p..2) = p
+  := eta_path_sigma_uncurried p.
+
+Definition path_path_sigma_uncurried {A : Type} (P : A -> Type) (u v : sigT P)
+  (p q : u = v)
+  (rs : {r : p..1 = q..1 & transport (fun x => transport P x u.2 = v.2) r p..2 = q..2})
+  : p = q.
+Proof.
+  destruct rs, p, u.
+  etransitivity; [ | apply eta_path_sigma ].
+  simpl in *.
+  induction p0.
+  admit.
+Defined.
+
diff --git a/test-suite/bugs/closed/4782.v b/test-suite/bugs/closed/4782.v
new file mode 100644
index 000000000..dbd71035d
--- /dev/null
+++ b/test-suite/bugs/closed/4782.v
@@ -0,0 +1,24 @@
+(* About typing of with bindings *)
+
+Record r : Type := mk_r { type : Type; cond : type -> Prop }.
+
+Inductive p : Prop := consp : forall (e : r) (x : type e), cond e x -> p.
+
+Goal p.
+Fail apply consp with (fun _ : bool => mk_r unit (fun x => True)) nil.
+ 
+(* A simplification of an example from coquelicot, which was failing
+   at some time after a fix #4782 was committed. *)
+
+Record T := { dom : Type }.
+Definition pairT A B := {| dom := (dom A * dom B)%type |}.
+Class C (A:Type).
+Parameter B:T.
+Instance c (A:T) : C (dom A).
+Instance cn : C (dom B).
+Parameter F : forall A:T, C (dom A) -> forall x:dom A, x=x -> A = A.
+Set Typeclasses Debug.
+Goal forall (A:T) (x:dom A), pairT A A = pairT A A.
+intros.
+apply (F _ _)  with (x,x).
+  
diff --git a/test-suite/bugs/closed/4785.v b/test-suite/bugs/closed/4785.v
new file mode 100644
index 000000000..c3c97d3f5
--- /dev/null
+++ b/test-suite/bugs/closed/4785.v
@@ -0,0 +1,45 @@
+Require Coq.Lists.List Coq.Vectors.Vector.
+Require Coq.Compat.Coq85.
+
+Module A.
+Import Coq.Lists.List Coq.Vectors.Vector.
+Import ListNotations.
+Check [ ]%list : list _.
+Import VectorNotations ListNotations.
+Delimit Scope vector_scope with vector.
+Check [ ]%vector : Vector.t _ _.
+Check []%vector : Vector.t _ _.
+Check [ ]%list : list _.
+Check []%list : list _.
+
+Goal True.
+  idtac; []. (* Check that vector notations don't break the [ | .. | ] syntax of Ltac *)
+Abort.
+
+Inductive mylist A := mynil | mycons (x : A) (xs : mylist A).
+Delimit Scope mylist_scope with mylist.
+Bind Scope mylist_scope with mylist.
+Arguments mynil {_}, _.
+Arguments mycons {_} _ _.
+Notation " [] " := mynil (compat "8.5") : mylist_scope.
+Notation " [ ] " := mynil (format "[ ]") : mylist_scope.
+Notation " [ x ] " := (mycons x nil) : mylist_scope.
+Notation " [ x ; y ; .. ; z ] " :=  (mycons x (mycons y .. (mycons z nil) ..)) : mylist_scope.
+
+Import Coq.Compat.Coq85.
+Locate Module VectorNotations.
+Import VectorDef.VectorNotations.
+
+Check []%vector : Vector.t _ _.
+Check []%mylist : mylist _.
+Check [ ]%mylist : mylist _.
+Check [ ]%list : list _.
+End A.
+
+Module B.
+Import Coq.Compat.Coq85.
+
+Goal True.
+  idtac; []. (* Check that importing the compat file doesn't break the [ | .. | ] syntax of Ltac *)
+Abort.
+End B.
diff --git a/test-suite/bugs/closed/4785_compat_85.v b/test-suite/bugs/closed/4785_compat_85.v
new file mode 100644
index 000000000..9d65840ac
--- /dev/null
+++ b/test-suite/bugs/closed/4785_compat_85.v
@@ -0,0 +1,46 @@
+(* -*- coq-prog-args: ("-emacs" "-compat" "8.5") -*- *)
+Require Coq.Lists.List Coq.Vectors.Vector.
+Require Coq.Compat.Coq85.
+
+Module A.
+Import Coq.Lists.List Coq.Vectors.Vector.
+Import ListNotations.
+Check [ ]%list : list _.
+Import VectorNotations ListNotations.
+Delimit Scope vector_scope with vector.
+Check [ ]%vector : Vector.t _ _.
+Check []%vector : Vector.t _ _.
+Check [ ]%list : list _.
+Fail Check []%list : list _.
+
+Goal True.
+  idtac; [ ]. (* Note that vector notations break the [ | .. | ] syntax of Ltac *)
+Abort.
+
+Inductive mylist A := mynil | mycons (x : A) (xs : mylist A).
+Delimit Scope mylist_scope with mylist.
+Bind Scope mylist_scope with mylist.
+Arguments mynil {_}, _.
+Arguments mycons {_} _ _.
+Notation " [] " := mynil (compat "8.5") : mylist_scope.
+Notation " [ ] " := mynil (format "[ ]") : mylist_scope.
+Notation " [ x ] " := (mycons x nil) : mylist_scope.
+Notation " [ x ; y ; .. ; z ] " :=  (mycons x (mycons y .. (mycons z nil) ..)) : mylist_scope.
+
+Import Coq.Compat.Coq85.
+Locate Module VectorNotations.
+Import VectorDef.VectorNotations.
+
+Check []%vector : Vector.t _ _.
+Check []%mylist : mylist _.
+Check [ ]%mylist : mylist _.
+Check [ ]%list : list _.
+End A.
+
+Module B.
+Import Coq.Compat.Coq85.
+
+Goal True.
+  idtac; []. (* Check that importing the compat file doesn't break the [ | .. | ] syntax of Ltac *)
+Abort.
+End B.
diff --git a/test-suite/bugs/closed/4787.v b/test-suite/bugs/closed/4787.v
new file mode 100644
index 000000000..b586cba50
--- /dev/null
+++ b/test-suite/bugs/closed/4787.v
@@ -0,0 +1,9 @@
+(* [Unset Bracketing Last Introduction Pattern] was not working *)
+
+Unset Bracketing Last Introduction Pattern.
+
+Goal forall T (x y : T * T), fst x = fst y /\ snd x = snd y -> x = y.
+do 10 ((intros [] || intro); simpl); reflexivity.
+Qed.
+
+
diff --git a/test-suite/bugs/closed/4798.v b/test-suite/bugs/closed/4798.v
new file mode 100644
index 000000000..dbc3d46fc
--- /dev/null
+++ b/test-suite/bugs/closed/4798.v
@@ -0,0 +1,3 @@
+Check match 2 with 0 => 0 | S n => n end.
+Notation "|" := 1 (compat "8.4").
+Check match 2 with 0 => 0 | S n => n end. (* fails *)
diff --git a/test-suite/bugs/closed/4811.v b/test-suite/bugs/closed/4811.v
new file mode 100644
index 000000000..a91496262
--- /dev/null
+++ b/test-suite/bugs/closed/4811.v
@@ -0,0 +1,1685 @@
+(* Test about a slowness of f_equal in 8.5pl1 *)
+
+(* Submitted by Jason Gross *)
+
+(* -*- mode: coq; coq-prog-args: ("-emacs" "-R" "src" "Crypto" "-R" "Bedrock" "Bedrock" "-R" "coqprime-8.5/Coqprime" "Coqprime" "-top" "GF255192") -*- *)
+(* File reduced by coq-bug-finder from original input, then from 162 lines to 23 lines, then from 245 lines to 95 lines, then from 198 lines to 101 lines, then from 654 lines to 452 lines, then from 591 lines to 505 lines, then from 1770 lines to 580 lines, then from 2238 lines to 1715 lines, then from 1776 lines to 1738 lines, then from 1750 lines to 1679 lines, then from 1693 lines to 1679 lines *)
+(* coqc version 8.5pl1 (April 2016) compiled on Apr 18 2016 14:48:5 with OCaml 4.02.3
+   coqtop version 8.5pl1 (April 2016) *)
+Require Coq.ZArith.ZArith.
+
+Import Coq.ZArith.ZArith.
+
+Axiom F : Z -> Set.
+Definition Let_In {A P} (x : A) (f : forall y : A, P y)
+  := let y := x in f y.
+Local Open Scope Z_scope.
+Definition modulus : Z := 2^255 - 19.
+Axiom decode : list Z -> F modulus.
+Goal    forall x9 x8 x7 x6 x5 x4 x3 x2 x1 x0 y9 y8 y7 y6 y5 y4 y3 y2 y1 y0 : Z,
+   let Zmul := Z.mul in
+   let Zadd := Z.add in
+   let Zsub := Z.sub in
+   let Zpow_pos := Z.pow_pos in
+   @eq (F (Zsub (Zpow_pos (Zpos (xO xH)) (xI (xI (xI (xI (xI (xI (xI xH)))))))) (Zpos (xI (xI (xO (xO xH)))))))
+     (@decode
+        (@Let_In Z (fun _ : Z => list Z)
+           (Zadd (Zmul x0 y0)
+              (Zmul (Zpos (xI (xI (xO (xO xH)))))
+                 (Zadd
+                    (Zadd
+                       (Zadd
+                          (Zadd
+                             (Zadd
+                                (Zadd
+                                   (Zadd (Zadd (Zmul (Zmul x9 y1) (Zpos (xO xH))) (Zmul x8 y2)) (Zmul (Zmul x7 y3) (Zpos (xO xH))))
+                                   (Zmul x6 y4)) (Zmul (Zmul x5 y5) (Zpos (xO xH)))) (Zmul x4 y6))
+                          (Zmul (Zmul x3 y7) (Zpos (xO xH)))) (Zmul x2 y8)) (Zmul (Zmul x1 y9) (Zpos (xO xH))))))
+           (fun z : Z =>
+            @Let_In Z (fun _ : Z => list Z)
+              (Zadd (Z.shiftr z (Zpos (xO (xI (xO (xI xH))))))
+                 (Zadd (Zadd (Zmul x1 y0) (Zmul x0 y1))
+                    (Zmul (Zpos (xI (xI (xO (xO xH)))))
+                       (Zadd
+                          (Zadd
+                             (Zadd (Zadd (Zadd (Zadd (Zadd (Zmul x9 y2) (Zmul x8 y3)) (Zmul x7 y4)) (Zmul x6 y5)) (Zmul x5 y6))
+                                (Zmul x4 y7)) (Zmul x3 y8)) (Zmul x2 y9)))))
+              (fun z0 : Z =>
+               @Let_In Z (fun _ : Z => list Z)
+                 (Zadd (Z.shiftr z0 (Zpos (xI (xO (xO (xI xH))))))
+                    (Zadd (Zadd (Zadd (Zmul x2 y0) (Zmul (Zmul x1 y1) (Zpos (xO xH)))) (Zmul x0 y2))
+                       (Zmul (Zpos (xI (xI (xO (xO xH)))))
+                          (Zadd
+                             (Zadd
+                                (Zadd
+                                   (Zadd
+                                      (Zadd (Zadd (Zmul (Zmul x9 y3) (Zpos (xO xH))) (Zmul x8 y4))
+                                         (Zmul (Zmul x7 y5) (Zpos (xO xH)))) (Zmul x6 y6)) (Zmul (Zmul x5 y7) (Zpos (xO xH))))
+                                (Zmul x4 y8)) (Zmul (Zmul x3 y9) (Zpos (xO xH)))))))
+                 (fun z1 : Z =>
+                  @Let_In Z (fun _ : Z => list Z)
+                    (Zadd (Z.shiftr z1 (Zpos (xO (xI (xO (xI xH))))))
+                       (Zadd (Zadd (Zadd (Zadd (Zmul x3 y0) (Zmul x2 y1)) (Zmul x1 y2)) (Zmul x0 y3))
+                          (Zmul (Zpos (xI (xI (xO (xO xH)))))
+                             (Zadd (Zadd (Zadd (Zadd (Zadd (Zmul x9 y4) (Zmul x8 y5)) (Zmul x7 y6)) (Zmul x6 y7)) (Zmul x5 y8))
+                                (Zmul x4 y9)))))
+                    (fun z2 : Z =>
+                     @Let_In Z (fun _ : Z => list Z)
+                       (Zadd (Z.shiftr z2 (Zpos (xI (xO (xO (xI xH))))))
+                          (Zadd
+                             (Zadd
+                                (Zadd (Zadd (Zadd (Zmul x4 y0) (Zmul (Zmul x3 y1) (Zpos (xO xH)))) (Zmul x2 y2))
+                                   (Zmul (Zmul x1 y3) (Zpos (xO xH)))) (Zmul x0 y4))
+                             (Zmul (Zpos (xI (xI (xO (xO xH)))))
+                                (Zadd
+                                   (Zadd
+                                      (Zadd (Zadd (Zmul (Zmul x9 y5) (Zpos (xO xH))) (Zmul x8 y6))
+                                         (Zmul (Zmul x7 y7) (Zpos (xO xH)))) (Zmul x6 y8)) (Zmul (Zmul x5 y9) (Zpos (xO xH)))))))
+                       (fun z3 : Z =>
+                        @Let_In Z (fun _ : Z => list Z)
+                          (Zadd (Z.shiftr z3 (Zpos (xO (xI (xO (xI xH))))))
+                             (Zadd
+                                (Zadd (Zadd (Zadd (Zadd (Zadd (Zmul x5 y0) (Zmul x4 y1)) (Zmul x3 y2)) (Zmul x2 y3)) (Zmul x1 y4))
+                                   (Zmul x0 y5))
+                                (Zmul (Zpos (xI (xI (xO (xO xH)))))
+                                   (Zadd (Zadd (Zadd (Zmul x9 y6) (Zmul x8 y7)) (Zmul x7 y8)) (Zmul x6 y9)))))
+                          (fun z4 : Z =>
+                           @Let_In Z (fun _ : Z => list Z)
+                             (Zadd (Z.shiftr z4 (Zpos (xI (xO (xO (xI xH))))))
+                                (Zadd
+                                   (Zadd
+                                      (Zadd
+                                         (Zadd
+                                            (Zadd (Zadd (Zadd (Zmul x6 y0) (Zmul (Zmul x5 y1) (Zpos (xO xH)))) (Zmul x4 y2))
+                                               (Zmul (Zmul x3 y3) (Zpos (xO xH)))) (Zmul x2 y4)) (Zmul (Zmul x1 y5) (Zpos (xO xH))))
+                                      (Zmul x0 y6))
+                                   (Zmul (Zpos (xI (xI (xO (xO xH)))))
+                                      (Zadd (Zadd (Zmul (Zmul x9 y7) (Zpos (xO xH))) (Zmul x8 y8))
+                                         (Zmul (Zmul x7 y9) (Zpos (xO xH)))))))
+                             (fun z5 : Z =>
+                              @Let_In Z (fun _ : Z => list Z)
+                                (Zadd (Z.shiftr z5 (Zpos (xO (xI (xO (xI xH))))))
+                                   (Zadd
+                                      (Zadd
+                                         (Zadd
+                                            (Zadd
+                                               (Zadd (Zadd (Zadd (Zadd (Zmul x7 y0) (Zmul x6 y1)) (Zmul x5 y2)) (Zmul x4 y3))
+                                                  (Zmul x3 y4)) (Zmul x2 y5)) (Zmul x1 y6)) (Zmul x0 y7))
+                                      (Zmul (Zpos (xI (xI (xO (xO xH))))) (Zadd (Zmul x9 y8) (Zmul x8 y9)))))
+                                (fun z6 : Z =>
+                                 @Let_In Z (fun _ : Z => list Z)
+                                   (Zadd (Z.shiftr z6 (Zpos (xI (xO (xO (xI xH))))))
+                                      (Zadd
+                                         (Zadd
+                                            (Zadd
+                                               (Zadd
+                                                  (Zadd
+                                                     (Zadd
+                                                        (Zadd
+                                                           (Zadd (Zadd (Zmul x8 y0) (Zmul (Zmul x7 y1) (Zpos (xO xH)))) (Zmul x6 y2))
+                                                           (Zmul (Zmul x5 y3) (Zpos (xO xH)))) (Zmul x4 y4))
+                                                     (Zmul (Zmul x3 y5) (Zpos (xO xH)))) (Zmul x2 y6))
+                                               (Zmul (Zmul x1 y7) (Zpos (xO xH)))) (Zmul x0 y8))
+                                         (Zmul (Zmul (Zmul (Zpos (xI (xI (xO (xO xH))))) x9) y9) (Zpos (xO xH)))))
+                                   (fun z7 : Z =>
+                                    @Let_In Z (fun _ : Z => list Z)
+                                      (Zadd (Z.shiftr z7 (Zpos (xO (xI (xO (xI xH))))))
+                                         (Zadd
+                                            (Zadd
+                                               (Zadd
+                                                  (Zadd
+                                                     (Zadd
+                                                        (Zadd
+                                                           (Zadd (Zadd (Zadd (Zmul x9 y0) (Zmul x8 y1)) (Zmul x7 y2)) (Zmul x6 y3))
+                                                           (Zmul x5 y4)) (Zmul x4 y5)) (Zmul x3 y6)) (Zmul x2 y7))
+                                               (Zmul x1 y8)) (Zmul x0 y9)))
+                                      (fun z8 : Z =>
+                                       @Let_In Z (fun _ : Z => list Z)
+                                         (Zadd (Zmul (Zpos (xI (xI (xO (xO xH))))) (Z.shiftr z8 (Zpos (xI (xO (xO (xI xH)))))))
+                                            (Z.land z
+                                               (Zpos
+                                                  (xI
+                                                     (xI
+                                                        (xI
+                                                           (xI
+                                                              (xI
+                                                                 (xI
+                                                                    (xI
+                                                                       (xI
+                                                                          (xI
+                                                                             (xI
+                                                                                (xI
+                                                                                   (xI
+                                                                                      (xI
+                                                                                         (xI
+                                                                                            (xI
+                                                                                               (xI
+                                                                                                  (xI
+                                                                                                     (xI
+                                                                                                       (xI
+                                                                                                       (xI
+                                                                                                       (xI (xI (xI (xI (xI xH))))))))))))))))))))))))))))
+                                         (fun z9 : Z =>
+                                          @cons Z
+                                            (Z.land z9
+                                               (Zpos
+                                                  (xI
+                                                     (xI
+                                                        (xI
+                                                           (xI
+                                                              (xI
+                                                                 (xI
+                                                                    (xI
+                                                                       (xI
+                                                                          (xI
+                                                                             (xI
+                                                                                (xI
+                                                                                   (xI
+                                                                                      (xI
+                                                                                         (xI
+                                                                                            (xI
+                                                                                               (xI
+                                                                                                  (xI
+                                                                                                     (xI
+                                                                                                       (xI
+                                                                                                       (xI
+                                                                                                       (xI (xI (xI (xI (xI xH)))))))))))))))))))))))))))
+                                            (@cons Z
+                                               (Zadd (Z.shiftr z9 (Zpos (xO (xI (xO (xI xH))))))
+                                                  (Z.land z0
+                                                     (Zpos
+                                                        (xI
+                                                           (xI
+                                                              (xI
+                                                                 (xI
+                                                                    (xI
+                                                                       (xI
+                                                                          (xI
+                                                                             (xI
+                                                                                (xI
+                                                                                   (xI
+                                                                                      (xI
+                                                                                         (xI
+                                                                                            (xI
+                                                                                               (xI
+                                                                                                  (xI
+                                                                                                     (xI
+                                                                                                       (xI
+                                                                                                       (xI
+                                                                                                       (xI
+                                                                                                       (xI (xI (xI (xI (xI xH)))))))))))))))))))))))))))
+                                               (@cons Z
+                                                  (Z.land z1
+                                                     (Zpos
+                                                        (xI
+                                                           (xI
+                                                              (xI
+                                                                 (xI
+                                                                    (xI
+                                                                       (xI
+                                                                          (xI
+                                                                             (xI
+                                                                                (xI
+                                                                                   (xI
+                                                                                      (xI
+                                                                                         (xI
+                                                                                            (xI
+                                                                                               (xI
+                                                                                                  (xI
+                                                                                                     (xI
+                                                                                                       (xI
+                                                                                                       (xI
+                                                                                                       (xI
+                                                                                                       (xI
+                                                                                                       (xI (xI (xI (xI (xI xH)))))))))))))))))))))))))))
+                                                  (@cons Z
+                                                     (Z.land z2
+                                                        (Zpos
+                                                           (xI
+                                                              (xI
+                                                                 (xI
+                                                                    (xI
+                                                                       (xI
+                                                                          (xI
+                                                                             (xI
+                                                                                (xI
+                                                                                   (xI
+                                                                                      (xI
+                                                                                         (xI
+                                                                                            (xI
+                                                                                               (xI
+                                                                                                  (xI
+                                                                                                     (xI
+                                                                                                       (xI
+                                                                                                       (xI
+                                                                                                       (xI
+                                                                                                       (xI
+                                                                                                       (xI (xI (xI (xI (xI xH))))))))))))))))))))))))))
+                                                     (@cons Z
+                                                        (Z.land z3
+                                                           (Zpos
+                                                              (xI
+                                                                 (xI
+                                                                    (xI
+                                                                       (xI
+                                                                          (xI
+                                                                             (xI
+                                                                                (xI
+                                                                                   (xI
+                                                                                      (xI
+                                                                                         (xI
+                                                                                            (xI
+                                                                                               (xI
+                                                                                                  (xI
+                                                                                                     (xI
+                                                                                                       (xI
+                                                                                                       (xI
+                                                                                                       (xI
+                                                                                                       (xI
+                                                                                                       (xI
+                                                                                                       (xI
+                                                                                                       (xI (xI (xI (xI (xI xH)))))))))))))))))))))))))))
+                                                        (@cons Z
+                                                           (Z.land z4
+                                                              (Zpos
+                                                                 (xI
+                                                                    (xI
+                                                                       (xI
+                                                                          (xI
+                                                                             (xI
+                                                                                (xI
+                                                                                   (xI
+                                                                                      (xI
+                                                                                         (xI
+                                                                                            (xI
+                                                                                               (xI
+                                                                                                  (xI
+                                                                                                     (xI
+                                                                                                       (xI
+                                                                                                       (xI
+                                                                                                       (xI
+                                                                                                       (xI
+                                                                                                       (xI
+                                                                                                       (xI
+                                                                                                       (xI (xI (xI (xI (xI xH))))))))))))))))))))))))))
+                                                           (@cons Z
+                                                              (Z.land z5
+                                                                 (Zpos
+                                                                    (xI
+                                                                       (xI
+                                                                          (xI
+                                                                             (xI
+                                                                                (xI
+                                                                                   (xI
+                                                                                      (xI
+                                                                                         (xI
+                                                                                            (xI
+                                                                                               (xI
+                                                                                                  (xI
+                                                                                                     (xI
+                                                                                                       (xI
+                                                                                                       (xI
+                                                                                                       (xI
+                                                                                                       (xI
+                                                                                                       (xI
+                                                                                                       (xI
+                                                                                                       (xI
+                                                                                                       (xI
+                                                                                                       (xI (xI (xI (xI (xI xH)))))))))))))))))))))))))))
+                                                              (@cons Z
+                                                                 (Z.land z6
+                                                                    (Zpos
+                                                                       (xI
+                                                                          (xI
+                                                                             (xI
+                                                                                (xI
+                                                                                   (xI
+                                                                                      (xI
+                                                                                         (xI
+                                                                                            (xI
+                                                                                               (xI
+                                                                                                  (xI
+                                                                                                     (xI
+                                                                                                       (xI
+                                                                                                       (xI
+                                                                                                       (xI
+                                                                                                       (xI
+                                                                                                       (xI
+                                                                                                       (xI
+                                                                                                       (xI
+                                                                                                       (xI
+                                                                                                       (xI (xI (xI (xI (xI xH))))))))))))))))))))))))))
+                                                                 (@cons Z
+                                                                    (Z.land z7
+                                                                       (Zpos
+                                                                          (xI
+                                                                             (xI
+                                                                                (xI
+                                                                                   (xI
+                                                                                      (xI
+                                                                                         (xI
+                                                                                            (xI
+                                                                                               (xI
+                                                                                                  (xI
+                                                                                                     (xI
+                                                                                                       (xI
+                                                                                                       (xI
+                                                                                                       (xI
+                                                                                                       (xI
+                                                                                                       (xI
+                                                                                                       (xI
+                                                                                                       (xI
+                                                                                                       (xI
+                                                                                                       (xI
+                                                                                                       (xI
+                                                                                                       (xI (xI (xI (xI (xI xH)))))))))))))))))))))))))))
+                                                                    (@cons Z
+                                                                       (Z.land z8
+                                                                          (Zpos
+                                                                             (xI
+                                                                                (xI
+                                                                                   (xI
+                                                                                      (xI
+                                                                                         (xI
+                                                                                            (xI
+                                                                                               (xI
+                                                                                                  (xI
+                                                                                                     (xI
+                                                                                                       (xI
+                                                                                                       (xI
+                                                                                                       (xI
+                                                                                                       (xI
+                                                                                                       (xI
+                                                                                                       (xI
+                                                                                                       (xI
+                                                                                                       (xI
+                                                                                                       (xI
+                                                                                                       (xI
+                                                                                                       (xI (xI (xI (xI (xI xH))))))))))))))))))))))))))
+                                                                       (@nil Z)))))))))))))))))))))))
+     (@decode
+        (@cons Z
+           (Z.land
+              (Zadd
+                 (Zmul (Zpos (xI (xI (xO (xO xH)))))
+                    (Z.shiftr
+                       (Zadd
+                          (Z.shiftr
+                             (Zadd
+                                (Z.shiftr
+                                   (Zadd
+                                      (Z.shiftr
+                                         (Zadd
+                                            (Z.shiftr
+                                               (Zadd
+                                                  (Z.shiftr
+                                                     (Zadd
+                                                        (Z.shiftr
+                                                           (Zadd
+                                                              (Z.shiftr
+                                                                 (Zadd
+                                                                    (Z.shiftr
+                                                                       (Zadd
+                                                                          (Z.shiftr
+                                                                             (Zadd (Zmul x0 y0)
+                                                                                (Zmul (Zpos (xI (xI (xO (xO xH)))))
+                                                                                   (Zadd
+                                                                                      (Zadd
+                                                                                         (Zadd
+                                                                                            (Zadd
+                                                                                               (Zadd
+                                                                                                  (Zadd
+                                                                                                     (Zadd
+                                                                                                       (Zadd
+                                                                                                       (Zmul
+                                                                                                       (Zmul x9 y1)
+                                                                                                       (Zpos (xO xH)))
+                                                                                                       (Zmul x8 y2))
+                                                                                                       (Zmul
+                                                                                                       (Zmul x7 y3)
+                                                                                                       (Zpos (xO xH))))
+                                                                                                     (Zmul x6 y4))
+                                                                                                  (Zmul (Zmul x5 y5) (Zpos (xO xH))))
+                                                                                               (Zmul x4 y6))
+                                                                                            (Zmul (Zmul x3 y7) (Zpos (xO xH))))
+                                                                                         (Zmul x2 y8))
+                                                                                      (Zmul (Zmul x1 y9) (Zpos (xO xH))))))
+                                                                             (Zpos (xO (xI (xO (xI xH))))))
+                                                                          (Zadd (Zadd (Zmul x1 y0) (Zmul x0 y1))
+                                                                             (Zmul (Zpos (xI (xI (xO (xO xH)))))
+                                                                                (Zadd
+                                                                                   (Zadd
+                                                                                      (Zadd
+                                                                                         (Zadd
+                                                                                            (Zadd
+                                                                                               (Zadd
+                                                                                                  (Zadd (Zmul x9 y2) (Zmul x8 y3))
+                                                                                                  (Zmul x7 y4))
+                                                                                               (Zmul x6 y5))
+                                                                                            (Zmul x5 y6))
+                                                                                         (Zmul x4 y7)) (Zmul x3 y8))
+                                                                                   (Zmul x2 y9))))) (Zpos (xI (xO (xO (xI xH))))))
+                                                                    (Zadd
+                                                                       (Zadd (Zadd (Zmul x2 y0) (Zmul (Zmul x1 y1) (Zpos (xO xH))))
+                                                                          (Zmul x0 y2))
+                                                                       (Zmul (Zpos (xI (xI (xO (xO xH)))))
+                                                                          (Zadd
+                                                                             (Zadd
+                                                                                (Zadd
+                                                                                   (Zadd
+                                                                                      (Zadd
+                                                                                         (Zadd (Zmul (Zmul x9 y3) (Zpos (xO xH)))
+                                                                                            (Zmul x8 y4))
+                                                                                         (Zmul (Zmul x7 y5) (Zpos (xO xH))))
+                                                                                      (Zmul x6 y6))
+                                                                                   (Zmul (Zmul x5 y7) (Zpos (xO xH))))
+                                                                                (Zmul x4 y8)) (Zmul (Zmul x3 y9) (Zpos (xO xH)))))))
+                                                                 (Zpos (xO (xI (xO (xI xH))))))
+                                                              (Zadd
+                                                                 (Zadd (Zadd (Zadd (Zmul x3 y0) (Zmul x2 y1)) (Zmul x1 y2))
+                                                                    (Zmul x0 y3))
+                                                                 (Zmul (Zpos (xI (xI (xO (xO xH)))))
+                                                                    (Zadd
+                                                                       (Zadd
+                                                                          (Zadd (Zadd (Zadd (Zmul x9 y4) (Zmul x8 y5)) (Zmul x7 y6))
+                                                                             (Zmul x6 y7)) (Zmul x5 y8))
+                                                                       (Zmul x4 y9))))) (Zpos (xI (xO (xO (xI xH))))))
+                                                        (Zadd
+                                                           (Zadd
+                                                              (Zadd
+                                                                 (Zadd (Zadd (Zmul x4 y0) (Zmul (Zmul x3 y1) (Zpos (xO xH))))
+                                                                    (Zmul x2 y2)) (Zmul (Zmul x1 y3) (Zpos (xO xH))))
+                                                              (Zmul x0 y4))
+                                                           (Zmul (Zpos (xI (xI (xO (xO xH)))))
+                                                              (Zadd
+                                                                 (Zadd
+                                                                    (Zadd (Zadd (Zmul (Zmul x9 y5) (Zpos (xO xH))) (Zmul x8 y6))
+                                                                       (Zmul (Zmul x7 y7) (Zpos (xO xH))))
+                                                                    (Zmul x6 y8)) (Zmul (Zmul x5 y9) (Zpos (xO xH)))))))
+                                                     (Zpos (xO (xI (xO (xI xH))))))
+                                                  (Zadd
+                                                     (Zadd
+                                                        (Zadd
+                                                           (Zadd (Zadd (Zadd (Zmul x5 y0) (Zmul x4 y1)) (Zmul x3 y2)) (Zmul x2 y3))
+                                                           (Zmul x1 y4)) (Zmul x0 y5))
+                                                     (Zmul (Zpos (xI (xI (xO (xO xH)))))
+                                                        (Zadd (Zadd (Zadd (Zmul x9 y6) (Zmul x8 y7)) (Zmul x7 y8)) (Zmul x6 y9)))))
+                                               (Zpos (xI (xO (xO (xI xH))))))
+                                            (Zadd
+                                               (Zadd
+                                                  (Zadd
+                                                     (Zadd
+                                                        (Zadd
+                                                           (Zadd (Zadd (Zmul x6 y0) (Zmul (Zmul x5 y1) (Zpos (xO xH)))) (Zmul x4 y2))
+                                                           (Zmul (Zmul x3 y3) (Zpos (xO xH)))) (Zmul x2 y4))
+                                                     (Zmul (Zmul x1 y5) (Zpos (xO xH)))) (Zmul x0 y6))
+                                               (Zmul (Zpos (xI (xI (xO (xO xH)))))
+                                                  (Zadd (Zadd (Zmul (Zmul x9 y7) (Zpos (xO xH))) (Zmul x8 y8))
+                                                     (Zmul (Zmul x7 y9) (Zpos (xO xH))))))) (Zpos (xO (xI (xO (xI xH))))))
+                                      (Zadd
+                                         (Zadd
+                                            (Zadd
+                                               (Zadd
+                                                  (Zadd (Zadd (Zadd (Zadd (Zmul x7 y0) (Zmul x6 y1)) (Zmul x5 y2)) (Zmul x4 y3))
+                                                     (Zmul x3 y4)) (Zmul x2 y5)) (Zmul x1 y6)) (Zmul x0 y7))
+                                         (Zmul (Zpos (xI (xI (xO (xO xH))))) (Zadd (Zmul x9 y8) (Zmul x8 y9)))))
+                                   (Zpos (xI (xO (xO (xI xH))))))
+                                (Zadd
+                                   (Zadd
+                                      (Zadd
+                                         (Zadd
+                                            (Zadd
+                                               (Zadd
+                                                  (Zadd (Zadd (Zadd (Zmul x8 y0) (Zmul (Zmul x7 y1) (Zpos (xO xH)))) (Zmul x6 y2))
+                                                     (Zmul (Zmul x5 y3) (Zpos (xO xH)))) (Zmul x4 y4))
+                                               (Zmul (Zmul x3 y5) (Zpos (xO xH)))) (Zmul x2 y6)) (Zmul (Zmul x1 y7) (Zpos (xO xH))))
+                                      (Zmul x0 y8)) (Zmul (Zmul (Zmul (Zpos (xI (xI (xO (xO xH))))) x9) y9) (Zpos (xO xH)))))
+                             (Zpos (xO (xI (xO (xI xH))))))
+                          (Zadd
+                             (Zadd
+                                (Zadd
+                                   (Zadd
+                                      (Zadd
+                                         (Zadd (Zadd (Zadd (Zadd (Zmul x9 y0) (Zmul x8 y1)) (Zmul x7 y2)) (Zmul x6 y3)) (Zmul x5 y4))
+                                         (Zmul x4 y5)) (Zmul x3 y6)) (Zmul x2 y7)) (Zmul x1 y8)) (Zmul x0 y9)))
+                       (Zpos (xI (xO (xO (xI xH)))))))
+                 (Z.land
+                    (Zadd (Zmul x0 y0)
+                       (Zmul (Zpos (xI (xI (xO (xO xH)))))
+                          (Zadd
+                             (Zadd
+                                (Zadd
+                                   (Zadd
+                                      (Zadd
+                                         (Zadd
+                                            (Zadd (Zadd (Zmul (Zmul x9 y1) (Zpos (xO xH))) (Zmul x8 y2))
+                                               (Zmul (Zmul x7 y3) (Zpos (xO xH)))) (Zmul x6 y4)) (Zmul (Zmul x5 y5) (Zpos (xO xH))))
+                                      (Zmul x4 y6)) (Zmul (Zmul x3 y7) (Zpos (xO xH)))) (Zmul x2 y8))
+                             (Zmul (Zmul x1 y9) (Zpos (xO xH))))))
+                    (Zpos
+                       (xI
+                          (xI
+                             (xI
+                                (xI
+                                   (xI
+                                      (xI
+                                         (xI
+                                            (xI
+                                               (xI
+                                                  (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI xH))))))))))))))))))))))))))))
+              (Zpos
+                 (xI
+                    (xI
+                       (xI
+                          (xI
+                             (xI
+                                (xI
+                                   (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI xH)))))))))))))))))))))))))))
+           (@cons Z
+              (Zadd
+                 (Z.shiftr
+                    (Zadd
+                       (Zmul (Zpos (xI (xI (xO (xO xH)))))
+                          (Z.shiftr
+                             (Zadd
+                                (Z.shiftr
+                                   (Zadd
+                                      (Z.shiftr
+                                         (Zadd
+                                            (Z.shiftr
+                                               (Zadd
+                                                  (Z.shiftr
+                                                     (Zadd
+                                                        (Z.shiftr
+                                                           (Zadd
+                                                              (Z.shiftr
+                                                                 (Zadd
+                                                                    (Z.shiftr
+                                                                       (Zadd
+                                                                          (Z.shiftr
+                                                                             (Zadd
+                                                                                (Z.shiftr
+                                                                                   (Zadd (Zmul x0 y0)
+                                                                                      (Zmul (Zpos (xI (xI (xO (xO xH)))))
+                                                                                         (Zadd
+                                                                                            (Zadd
+                                                                                               (Zadd
+                                                                                                  (Zadd
+                                                                                                     (Zadd
+                                                                                                       (Zadd
+                                                                                                       (Zadd
+                                                                                                       (Zadd
+                                                                                                       (Zmul
+                                                                                                       (Zmul x9 y1)
+                                                                                                       (Zpos (xO xH)))
+                                                                                                       (Zmul x8 y2))
+                                                                                                       (Zmul
+                                                                                                       (Zmul x7 y3)
+                                                                                                       (Zpos (xO xH))))
+                                                                                                       (Zmul x6 y4))
+                                                                                                       (Zmul
+                                                                                                       (Zmul x5 y5)
+                                                                                                       (Zpos (xO xH))))
+                                                                                                     (Zmul x4 y6))
+                                                                                                  (Zmul (Zmul x3 y7) (Zpos (xO xH))))
+                                                                                               (Zmul x2 y8))
+                                                                                            (Zmul (Zmul x1 y9) (Zpos (xO xH))))))
+                                                                                   (Zpos (xO (xI (xO (xI xH))))))
+                                                                                (Zadd (Zadd (Zmul x1 y0) (Zmul x0 y1))
+                                                                                   (Zmul (Zpos (xI (xI (xO (xO xH)))))
+                                                                                      (Zadd
+                                                                                         (Zadd
+                                                                                            (Zadd
+                                                                                               (Zadd
+                                                                                                  (Zadd
+                                                                                                     (Zadd
+                                                                                                       (Zadd
+                                                                                                       (Zmul x9 y2)
+                                                                                                       (Zmul x8 y3))
+                                                                                                       (Zmul x7 y4))
+                                                                                                     (Zmul x6 y5))
+                                                                                                  (Zmul x5 y6))
+                                                                                               (Zmul x4 y7))
+                                                                                            (Zmul x3 y8))
+                                                                                         (Zmul x2 y9)))))
+                                                                             (Zpos (xI (xO (xO (xI xH))))))
+                                                                          (Zadd
+                                                                             (Zadd
+                                                                                (Zadd (Zmul x2 y0)
+                                                                                   (Zmul (Zmul x1 y1) (Zpos (xO xH))))
+                                                                                (Zmul x0 y2))
+                                                                             (Zmul (Zpos (xI (xI (xO (xO xH)))))
+                                                                                (Zadd
+                                                                                   (Zadd
+                                                                                      (Zadd
+                                                                                         (Zadd
+                                                                                            (Zadd
+                                                                                               (Zadd
+                                                                                                  (Zmul (Zmul x9 y3) (Zpos (xO xH)))
+                                                                                                  (Zmul x8 y4))
+                                                                                               (Zmul (Zmul x7 y5) (Zpos (xO xH))))
+                                                                                            (Zmul x6 y6))
+                                                                                         (Zmul (Zmul x5 y7) (Zpos (xO xH))))
+                                                                                      (Zmul x4 y8))
+                                                                                   (Zmul (Zmul x3 y9) (Zpos (xO xH)))))))
+                                                                       (Zpos (xO (xI (xO (xI xH))))))
+                                                                    (Zadd
+                                                                       (Zadd (Zadd (Zadd (Zmul x3 y0) (Zmul x2 y1)) (Zmul x1 y2))
+                                                                          (Zmul x0 y3))
+                                                                       (Zmul (Zpos (xI (xI (xO (xO xH)))))
+                                                                          (Zadd
+                                                                             (Zadd
+                                                                                (Zadd
+                                                                                   (Zadd (Zadd (Zmul x9 y4) (Zmul x8 y5))
+                                                                                      (Zmul x7 y6)) (Zmul x6 y7))
+                                                                                (Zmul x5 y8)) (Zmul x4 y9)))))
+                                                                 (Zpos (xI (xO (xO (xI xH))))))
+                                                              (Zadd
+                                                                 (Zadd
+                                                                    (Zadd
+                                                                       (Zadd (Zadd (Zmul x4 y0) (Zmul (Zmul x3 y1) (Zpos (xO xH))))
+                                                                          (Zmul x2 y2)) (Zmul (Zmul x1 y3) (Zpos (xO xH))))
+                                                                    (Zmul x0 y4))
+                                                                 (Zmul (Zpos (xI (xI (xO (xO xH)))))
+                                                                    (Zadd
+                                                                       (Zadd
+                                                                          (Zadd
+                                                                             (Zadd (Zmul (Zmul x9 y5) (Zpos (xO xH))) (Zmul x8 y6))
+                                                                             (Zmul (Zmul x7 y7) (Zpos (xO xH))))
+                                                                          (Zmul x6 y8)) (Zmul (Zmul x5 y9) (Zpos (xO xH)))))))
+                                                           (Zpos (xO (xI (xO (xI xH))))))
+                                                        (Zadd
+                                                           (Zadd
+                                                              (Zadd
+                                                                 (Zadd (Zadd (Zadd (Zmul x5 y0) (Zmul x4 y1)) (Zmul x3 y2))
+                                                                    (Zmul x2 y3)) (Zmul x1 y4)) (Zmul x0 y5))
+                                                           (Zmul (Zpos (xI (xI (xO (xO xH)))))
+                                                              (Zadd (Zadd (Zadd (Zmul x9 y6) (Zmul x8 y7)) (Zmul x7 y8))
+                                                                 (Zmul x6 y9))))) (Zpos (xI (xO (xO (xI xH))))))
+                                                  (Zadd
+                                                     (Zadd
+                                                        (Zadd
+                                                           (Zadd
+                                                              (Zadd
+                                                                 (Zadd (Zadd (Zmul x6 y0) (Zmul (Zmul x5 y1) (Zpos (xO xH))))
+                                                                    (Zmul x4 y2)) (Zmul (Zmul x3 y3) (Zpos (xO xH))))
+                                                              (Zmul x2 y4)) (Zmul (Zmul x1 y5) (Zpos (xO xH))))
+                                                        (Zmul x0 y6))
+                                                     (Zmul (Zpos (xI (xI (xO (xO xH)))))
+                                                        (Zadd (Zadd (Zmul (Zmul x9 y7) (Zpos (xO xH))) (Zmul x8 y8))
+                                                           (Zmul (Zmul x7 y9) (Zpos (xO xH))))))) (Zpos (xO (xI (xO (xI xH))))))
+                                            (Zadd
+                                               (Zadd
+                                                  (Zadd
+                                                     (Zadd
+                                                        (Zadd
+                                                           (Zadd (Zadd (Zadd (Zmul x7 y0) (Zmul x6 y1)) (Zmul x5 y2)) (Zmul x4 y3))
+                                                           (Zmul x3 y4)) (Zmul x2 y5)) (Zmul x1 y6)) (Zmul x0 y7))
+                                               (Zmul (Zpos (xI (xI (xO (xO xH))))) (Zadd (Zmul x9 y8) (Zmul x8 y9)))))
+                                         (Zpos (xI (xO (xO (xI xH))))))
+                                      (Zadd
+                                         (Zadd
+                                            (Zadd
+                                               (Zadd
+                                                  (Zadd
+                                                     (Zadd
+                                                        (Zadd
+                                                           (Zadd (Zadd (Zmul x8 y0) (Zmul (Zmul x7 y1) (Zpos (xO xH)))) (Zmul x6 y2))
+                                                           (Zmul (Zmul x5 y3) (Zpos (xO xH)))) (Zmul x4 y4))
+                                                     (Zmul (Zmul x3 y5) (Zpos (xO xH)))) (Zmul x2 y6))
+                                               (Zmul (Zmul x1 y7) (Zpos (xO xH)))) (Zmul x0 y8))
+                                         (Zmul (Zmul (Zmul (Zpos (xI (xI (xO (xO xH))))) x9) y9) (Zpos (xO xH)))))
+                                   (Zpos (xO (xI (xO (xI xH))))))
+                                (Zadd
+                                   (Zadd
+                                      (Zadd
+                                         (Zadd
+                                            (Zadd
+                                               (Zadd (Zadd (Zadd (Zadd (Zmul x9 y0) (Zmul x8 y1)) (Zmul x7 y2)) (Zmul x6 y3))
+                                                  (Zmul x5 y4)) (Zmul x4 y5)) (Zmul x3 y6)) (Zmul x2 y7))
+                                      (Zmul x1 y8)) (Zmul x0 y9))) (Zpos (xI (xO (xO (xI xH)))))))
+                       (Z.land
+                          (Zadd (Zmul x0 y0)
+                             (Zmul (Zpos (xI (xI (xO (xO xH)))))
+                                (Zadd
+                                   (Zadd
+                                      (Zadd
+                                         (Zadd
+                                            (Zadd
+                                               (Zadd
+                                                  (Zadd (Zadd (Zmul (Zmul x9 y1) (Zpos (xO xH))) (Zmul x8 y2))
+                                                     (Zmul (Zmul x7 y3) (Zpos (xO xH)))) (Zmul x6 y4))
+                                               (Zmul (Zmul x5 y5) (Zpos (xO xH)))) (Zmul x4 y6)) (Zmul (Zmul x3 y7) (Zpos (xO xH))))
+                                      (Zmul x2 y8)) (Zmul (Zmul x1 y9) (Zpos (xO xH))))))
+                          (Zpos
+                             (xI
+                                (xI
+                                   (xI
+                                      (xI
+                                         (xI
+                                            (xI
+                                               (xI
+                                                  (xI
+                                                     (xI
+                                                        (xI
+                                                           (xI
+                                                              (xI
+                                                                 (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI xH))))))))))))))))))))))))))))
+                    (Zpos (xO (xI (xO (xI xH))))))
+                 (Z.land
+                    (Zadd
+                       (Z.shiftr
+                          (Zadd (Zmul x0 y0)
+                             (Zmul (Zpos (xI (xI (xO (xO xH)))))
+                                (Zadd
+                                   (Zadd
+                                      (Zadd
+                                         (Zadd
+                                            (Zadd
+                                               (Zadd
+                                                  (Zadd (Zadd (Zmul (Zmul x9 y1) (Zpos (xO xH))) (Zmul x8 y2))
+                                                     (Zmul (Zmul x7 y3) (Zpos (xO xH)))) (Zmul x6 y4))
+                                               (Zmul (Zmul x5 y5) (Zpos (xO xH)))) (Zmul x4 y6)) (Zmul (Zmul x3 y7) (Zpos (xO xH))))
+                                      (Zmul x2 y8)) (Zmul (Zmul x1 y9) (Zpos (xO xH)))))) (Zpos (xO (xI (xO (xI xH))))))
+                       (Zadd (Zadd (Zmul x1 y0) (Zmul x0 y1))
+                          (Zmul (Zpos (xI (xI (xO (xO xH)))))
+                             (Zadd
+                                (Zadd
+                                   (Zadd
+                                      (Zadd (Zadd (Zadd (Zadd (Zmul x9 y2) (Zmul x8 y3)) (Zmul x7 y4)) (Zmul x6 y5)) (Zmul x5 y6))
+                                      (Zmul x4 y7)) (Zmul x3 y8)) (Zmul x2 y9)))))
+                    (Zpos
+                       (xI
+                          (xI
+                             (xI
+                                (xI
+                                   (xI
+                                      (xI
+                                         (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI xH)))))))))))))))))))))))))))
+              (@cons Z
+                 (Z.land
+                    (Zadd
+                       (Z.shiftr
+                          (Zadd
+                             (Z.shiftr
+                                (Zadd (Zmul x0 y0)
+                                   (Zmul (Zpos (xI (xI (xO (xO xH)))))
+                                      (Zadd
+                                         (Zadd
+                                            (Zadd
+                                               (Zadd
+                                                  (Zadd
+                                                     (Zadd
+                                                        (Zadd (Zadd (Zmul (Zmul x9 y1) (Zpos (xO xH))) (Zmul x8 y2))
+                                                           (Zmul (Zmul x7 y3) (Zpos (xO xH)))) (Zmul x6 y4))
+                                                     (Zmul (Zmul x5 y5) (Zpos (xO xH)))) (Zmul x4 y6))
+                                               (Zmul (Zmul x3 y7) (Zpos (xO xH)))) (Zmul x2 y8)) (Zmul (Zmul x1 y9) (Zpos (xO xH))))))
+                                (Zpos (xO (xI (xO (xI xH))))))
+                             (Zadd (Zadd (Zmul x1 y0) (Zmul x0 y1))
+                                (Zmul (Zpos (xI (xI (xO (xO xH)))))
+                                   (Zadd
+                                      (Zadd
+                                         (Zadd
+                                            (Zadd (Zadd (Zadd (Zadd (Zmul x9 y2) (Zmul x8 y3)) (Zmul x7 y4)) (Zmul x6 y5))
+                                               (Zmul x5 y6)) (Zmul x4 y7)) (Zmul x3 y8)) (Zmul x2 y9)))))
+                          (Zpos (xI (xO (xO (xI xH))))))
+                       (Zadd (Zadd (Zadd (Zmul x2 y0) (Zmul (Zmul x1 y1) (Zpos (xO xH)))) (Zmul x0 y2))
+                          (Zmul (Zpos (xI (xI (xO (xO xH)))))
+                             (Zadd
+                                (Zadd
+                                   (Zadd
+                                      (Zadd
+                                         (Zadd (Zadd (Zmul (Zmul x9 y3) (Zpos (xO xH))) (Zmul x8 y4))
+                                            (Zmul (Zmul x7 y5) (Zpos (xO xH)))) (Zmul x6 y6)) (Zmul (Zmul x5 y7) (Zpos (xO xH))))
+                                   (Zmul x4 y8)) (Zmul (Zmul x3 y9) (Zpos (xO xH)))))))
+                    (Zpos
+                       (xI
+                          (xI
+                             (xI
+                                (xI
+                                   (xI
+                                      (xI
+                                         (xI
+                                            (xI
+                                               (xI
+                                                  (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI xH)))))))))))))))))))))))))))
+                 (@cons Z
+                    (Z.land
+                       (Zadd
+                          (Z.shiftr
+                             (Zadd
+                                (Z.shiftr
+                                   (Zadd
+                                      (Z.shiftr
+                                         (Zadd (Zmul x0 y0)
+                                            (Zmul (Zpos (xI (xI (xO (xO xH)))))
+                                               (Zadd
+                                                  (Zadd
+                                                     (Zadd
+                                                        (Zadd
+                                                           (Zadd
+                                                              (Zadd
+                                                                 (Zadd (Zadd (Zmul (Zmul x9 y1) (Zpos (xO xH))) (Zmul x8 y2))
+                                                                    (Zmul (Zmul x7 y3) (Zpos (xO xH))))
+                                                                 (Zmul x6 y4)) (Zmul (Zmul x5 y5) (Zpos (xO xH))))
+                                                           (Zmul x4 y6)) (Zmul (Zmul x3 y7) (Zpos (xO xH))))
+                                                     (Zmul x2 y8)) (Zmul (Zmul x1 y9) (Zpos (xO xH))))))
+                                         (Zpos (xO (xI (xO (xI xH))))))
+                                      (Zadd (Zadd (Zmul x1 y0) (Zmul x0 y1))
+                                         (Zmul (Zpos (xI (xI (xO (xO xH)))))
+                                            (Zadd
+                                               (Zadd
+                                                  (Zadd
+                                                     (Zadd (Zadd (Zadd (Zadd (Zmul x9 y2) (Zmul x8 y3)) (Zmul x7 y4)) (Zmul x6 y5))
+                                                        (Zmul x5 y6)) (Zmul x4 y7)) (Zmul x3 y8)) (Zmul x2 y9)))))
+                                   (Zpos (xI (xO (xO (xI xH))))))
+                                (Zadd (Zadd (Zadd (Zmul x2 y0) (Zmul (Zmul x1 y1) (Zpos (xO xH)))) (Zmul x0 y2))
+                                   (Zmul (Zpos (xI (xI (xO (xO xH)))))
+                                      (Zadd
+                                         (Zadd
+                                            (Zadd
+                                               (Zadd
+                                                  (Zadd (Zadd (Zmul (Zmul x9 y3) (Zpos (xO xH))) (Zmul x8 y4))
+                                                     (Zmul (Zmul x7 y5) (Zpos (xO xH)))) (Zmul x6 y6))
+                                               (Zmul (Zmul x5 y7) (Zpos (xO xH)))) (Zmul x4 y8)) (Zmul (Zmul x3 y9) (Zpos (xO xH)))))))
+                             (Zpos (xO (xI (xO (xI xH))))))
+                          (Zadd (Zadd (Zadd (Zadd (Zmul x3 y0) (Zmul x2 y1)) (Zmul x1 y2)) (Zmul x0 y3))
+                             (Zmul (Zpos (xI (xI (xO (xO xH)))))
+                                (Zadd (Zadd (Zadd (Zadd (Zadd (Zmul x9 y4) (Zmul x8 y5)) (Zmul x7 y6)) (Zmul x6 y7)) (Zmul x5 y8))
+                                   (Zmul x4 y9)))))
+                       (Zpos
+                          (xI
+                             (xI
+                                (xI
+                                   (xI
+                                      (xI
+                                         (xI
+                                            (xI
+                                               (xI
+                                                  (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI xH))))))))))))))))))))))))))
+                    (@cons Z
+                       (Z.land
+                          (Zadd
+                             (Z.shiftr
+                                (Zadd
+                                   (Z.shiftr
+                                      (Zadd
+                                         (Z.shiftr
+                                            (Zadd
+                                               (Z.shiftr
+                                                  (Zadd (Zmul x0 y0)
+                                                     (Zmul (Zpos (xI (xI (xO (xO xH)))))
+                                                        (Zadd
+                                                           (Zadd
+                                                              (Zadd
+                                                                 (Zadd
+                                                                    (Zadd
+                                                                       (Zadd
+                                                                          (Zadd
+                                                                             (Zadd (Zmul (Zmul x9 y1) (Zpos (xO xH))) (Zmul x8 y2))
+                                                                             (Zmul (Zmul x7 y3) (Zpos (xO xH))))
+                                                                          (Zmul x6 y4)) (Zmul (Zmul x5 y5) (Zpos (xO xH))))
+                                                                    (Zmul x4 y6)) (Zmul (Zmul x3 y7) (Zpos (xO xH))))
+                                                              (Zmul x2 y8)) (Zmul (Zmul x1 y9) (Zpos (xO xH))))))
+                                                  (Zpos (xO (xI (xO (xI xH))))))
+                                               (Zadd (Zadd (Zmul x1 y0) (Zmul x0 y1))
+                                                  (Zmul (Zpos (xI (xI (xO (xO xH)))))
+                                                     (Zadd
+                                                        (Zadd
+                                                           (Zadd
+                                                              (Zadd
+                                                                 (Zadd (Zadd (Zadd (Zmul x9 y2) (Zmul x8 y3)) (Zmul x7 y4))
+                                                                    (Zmul x6 y5)) (Zmul x5 y6)) (Zmul x4 y7))
+                                                           (Zmul x3 y8)) (Zmul x2 y9))))) (Zpos (xI (xO (xO (xI xH))))))
+                                         (Zadd (Zadd (Zadd (Zmul x2 y0) (Zmul (Zmul x1 y1) (Zpos (xO xH)))) (Zmul x0 y2))
+                                            (Zmul (Zpos (xI (xI (xO (xO xH)))))
+                                               (Zadd
+                                                  (Zadd
+                                                     (Zadd
+                                                        (Zadd
+                                                           (Zadd (Zadd (Zmul (Zmul x9 y3) (Zpos (xO xH))) (Zmul x8 y4))
+                                                              (Zmul (Zmul x7 y5) (Zpos (xO xH)))) (Zmul x6 y6))
+                                                        (Zmul (Zmul x5 y7) (Zpos (xO xH)))) (Zmul x4 y8))
+                                                  (Zmul (Zmul x3 y9) (Zpos (xO xH))))))) (Zpos (xO (xI (xO (xI xH))))))
+                                   (Zadd (Zadd (Zadd (Zadd (Zmul x3 y0) (Zmul x2 y1)) (Zmul x1 y2)) (Zmul x0 y3))
+                                      (Zmul (Zpos (xI (xI (xO (xO xH)))))
+                                         (Zadd
+                                            (Zadd (Zadd (Zadd (Zadd (Zmul x9 y4) (Zmul x8 y5)) (Zmul x7 y6)) (Zmul x6 y7))
+                                               (Zmul x5 y8)) (Zmul x4 y9))))) (Zpos (xI (xO (xO (xI xH))))))
+                             (Zadd
+                                (Zadd
+                                   (Zadd (Zadd (Zadd (Zmul x4 y0) (Zmul (Zmul x3 y1) (Zpos (xO xH)))) (Zmul x2 y2))
+                                      (Zmul (Zmul x1 y3) (Zpos (xO xH)))) (Zmul x0 y4))
+                                (Zmul (Zpos (xI (xI (xO (xO xH)))))
+                                   (Zadd
+                                      (Zadd
+                                         (Zadd (Zadd (Zmul (Zmul x9 y5) (Zpos (xO xH))) (Zmul x8 y6))
+                                            (Zmul (Zmul x7 y7) (Zpos (xO xH)))) (Zmul x6 y8)) (Zmul (Zmul x5 y9) (Zpos (xO xH)))))))
+                          (Zpos
+                             (xI
+                                (xI
+                                   (xI
+                                      (xI
+                                         (xI
+                                            (xI
+                                               (xI
+                                                  (xI
+                                                     (xI
+                                                        (xI
+                                                           (xI
+                                                              (xI
+                                                                 (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI xH)))))))))))))))))))))))))))
+                       (@cons Z
+                          (Z.land
+                             (Zadd
+                                (Z.shiftr
+                                   (Zadd
+                                      (Z.shiftr
+                                         (Zadd
+                                            (Z.shiftr
+                                               (Zadd
+                                                  (Z.shiftr
+                                                     (Zadd
+                                                        (Z.shiftr
+                                                           (Zadd (Zmul x0 y0)
+                                                              (Zmul (Zpos (xI (xI (xO (xO xH)))))
+                                                                 (Zadd
+                                                                    (Zadd
+                                                                       (Zadd
+                                                                          (Zadd
+                                                                             (Zadd
+                                                                                (Zadd
+                                                                                   (Zadd
+                                                                                      (Zadd (Zmul (Zmul x9 y1) (Zpos (xO xH)))
+                                                                                         (Zmul x8 y2))
+                                                                                      (Zmul (Zmul x7 y3) (Zpos (xO xH))))
+                                                                                   (Zmul x6 y4)) (Zmul (Zmul x5 y5) (Zpos (xO xH))))
+                                                                             (Zmul x4 y6)) (Zmul (Zmul x3 y7) (Zpos (xO xH))))
+                                                                       (Zmul x2 y8)) (Zmul (Zmul x1 y9) (Zpos (xO xH))))))
+                                                           (Zpos (xO (xI (xO (xI xH))))))
+                                                        (Zadd (Zadd (Zmul x1 y0) (Zmul x0 y1))
+                                                           (Zmul (Zpos (xI (xI (xO (xO xH)))))
+                                                              (Zadd
+                                                                 (Zadd
+                                                                    (Zadd
+                                                                       (Zadd
+                                                                          (Zadd (Zadd (Zadd (Zmul x9 y2) (Zmul x8 y3)) (Zmul x7 y4))
+                                                                             (Zmul x6 y5)) (Zmul x5 y6))
+                                                                       (Zmul x4 y7)) (Zmul x3 y8)) (Zmul x2 y9)))))
+                                                     (Zpos (xI (xO (xO (xI xH))))))
+                                                  (Zadd (Zadd (Zadd (Zmul x2 y0) (Zmul (Zmul x1 y1) (Zpos (xO xH)))) (Zmul x0 y2))
+                                                     (Zmul (Zpos (xI (xI (xO (xO xH)))))
+                                                        (Zadd
+                                                           (Zadd
+                                                              (Zadd
+                                                                 (Zadd
+                                                                    (Zadd (Zadd (Zmul (Zmul x9 y3) (Zpos (xO xH))) (Zmul x8 y4))
+                                                                       (Zmul (Zmul x7 y5) (Zpos (xO xH))))
+                                                                    (Zmul x6 y6)) (Zmul (Zmul x5 y7) (Zpos (xO xH))))
+                                                              (Zmul x4 y8)) (Zmul (Zmul x3 y9) (Zpos (xO xH)))))))
+                                               (Zpos (xO (xI (xO (xI xH))))))
+                                            (Zadd (Zadd (Zadd (Zadd (Zmul x3 y0) (Zmul x2 y1)) (Zmul x1 y2)) (Zmul x0 y3))
+                                               (Zmul (Zpos (xI (xI (xO (xO xH)))))
+                                                  (Zadd
+                                                     (Zadd (Zadd (Zadd (Zadd (Zmul x9 y4) (Zmul x8 y5)) (Zmul x7 y6)) (Zmul x6 y7))
+                                                        (Zmul x5 y8)) (Zmul x4 y9))))) (Zpos (xI (xO (xO (xI xH))))))
+                                      (Zadd
+                                         (Zadd
+                                            (Zadd (Zadd (Zadd (Zmul x4 y0) (Zmul (Zmul x3 y1) (Zpos (xO xH)))) (Zmul x2 y2))
+                                               (Zmul (Zmul x1 y3) (Zpos (xO xH)))) (Zmul x0 y4))
+                                         (Zmul (Zpos (xI (xI (xO (xO xH)))))
+                                            (Zadd
+                                               (Zadd
+                                                  (Zadd (Zadd (Zmul (Zmul x9 y5) (Zpos (xO xH))) (Zmul x8 y6))
+                                                     (Zmul (Zmul x7 y7) (Zpos (xO xH)))) (Zmul x6 y8))
+                                               (Zmul (Zmul x5 y9) (Zpos (xO xH))))))) (Zpos (xO (xI (xO (xI xH))))))
+                                (Zadd
+                                   (Zadd
+                                      (Zadd (Zadd (Zadd (Zadd (Zmul x5 y0) (Zmul x4 y1)) (Zmul x3 y2)) (Zmul x2 y3)) (Zmul x1 y4))
+                                      (Zmul x0 y5))
+                                   (Zmul (Zpos (xI (xI (xO (xO xH)))))
+                                      (Zadd (Zadd (Zadd (Zmul x9 y6) (Zmul x8 y7)) (Zmul x7 y8)) (Zmul x6 y9)))))
+                             (Zpos
+                                (xI
+                                   (xI
+                                      (xI
+                                         (xI
+                                            (xI
+                                               (xI
+                                                  (xI
+                                                     (xI
+                                                        (xI
+                                                           (xI
+                                                              (xI
+                                                                 (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI xH))))))))))))))))))))))))))
+                          (@cons Z
+                             (Z.land
+                                (Zadd
+                                   (Z.shiftr
+                                      (Zadd
+                                         (Z.shiftr
+                                            (Zadd
+                                               (Z.shiftr
+                                                  (Zadd
+                                                     (Z.shiftr
+                                                        (Zadd
+                                                           (Z.shiftr
+                                                              (Zadd
+                                                                 (Z.shiftr
+                                                                    (Zadd (Zmul x0 y0)
+                                                                       (Zmul (Zpos (xI (xI (xO (xO xH)))))
+                                                                          (Zadd
+                                                                             (Zadd
+                                                                                (Zadd
+                                                                                   (Zadd
+                                                                                      (Zadd
+                                                                                         (Zadd
+                                                                                            (Zadd
+                                                                                               (Zadd
+                                                                                                  (Zmul (Zmul x9 y1) (Zpos (xO xH)))
+                                                                                                  (Zmul x8 y2))
+                                                                                               (Zmul (Zmul x7 y3) (Zpos (xO xH))))
+                                                                                            (Zmul x6 y4))
+                                                                                         (Zmul (Zmul x5 y5) (Zpos (xO xH))))
+                                                                                      (Zmul x4 y6))
+                                                                                   (Zmul (Zmul x3 y7) (Zpos (xO xH))))
+                                                                                (Zmul x2 y8)) (Zmul (Zmul x1 y9) (Zpos (xO xH))))))
+                                                                    (Zpos (xO (xI (xO (xI xH))))))
+                                                                 (Zadd (Zadd (Zmul x1 y0) (Zmul x0 y1))
+                                                                    (Zmul (Zpos (xI (xI (xO (xO xH)))))
+                                                                       (Zadd
+                                                                          (Zadd
+                                                                             (Zadd
+                                                                                (Zadd
+                                                                                   (Zadd
+                                                                                      (Zadd (Zadd (Zmul x9 y2) (Zmul x8 y3))
+                                                                                         (Zmul x7 y4)) (Zmul x6 y5))
+                                                                                   (Zmul x5 y6)) (Zmul x4 y7))
+                                                                             (Zmul x3 y8)) (Zmul x2 y9)))))
+                                                              (Zpos (xI (xO (xO (xI xH))))))
+                                                           (Zadd
+                                                              (Zadd (Zadd (Zmul x2 y0) (Zmul (Zmul x1 y1) (Zpos (xO xH))))
+                                                                 (Zmul x0 y2))
+                                                              (Zmul (Zpos (xI (xI (xO (xO xH)))))
+                                                                 (Zadd
+                                                                    (Zadd
+                                                                       (Zadd
+                                                                          (Zadd
+                                                                             (Zadd
+                                                                                (Zadd (Zmul (Zmul x9 y3) (Zpos (xO xH)))
+                                                                                   (Zmul x8 y4)) (Zmul (Zmul x7 y5) (Zpos (xO xH))))
+                                                                             (Zmul x6 y6)) (Zmul (Zmul x5 y7) (Zpos (xO xH))))
+                                                                       (Zmul x4 y8)) (Zmul (Zmul x3 y9) (Zpos (xO xH)))))))
+                                                        (Zpos (xO (xI (xO (xI xH))))))
+                                                     (Zadd (Zadd (Zadd (Zadd (Zmul x3 y0) (Zmul x2 y1)) (Zmul x1 y2)) (Zmul x0 y3))
+                                                        (Zmul (Zpos (xI (xI (xO (xO xH)))))
+                                                           (Zadd
+                                                              (Zadd
+                                                                 (Zadd (Zadd (Zadd (Zmul x9 y4) (Zmul x8 y5)) (Zmul x7 y6))
+                                                                    (Zmul x6 y7)) (Zmul x5 y8)) (Zmul x4 y9)))))
+                                                  (Zpos (xI (xO (xO (xI xH))))))
+                                               (Zadd
+                                                  (Zadd
+                                                     (Zadd
+                                                        (Zadd (Zadd (Zmul x4 y0) (Zmul (Zmul x3 y1) (Zpos (xO xH)))) (Zmul x2 y2))
+                                                        (Zmul (Zmul x1 y3) (Zpos (xO xH)))) (Zmul x0 y4))
+                                                  (Zmul (Zpos (xI (xI (xO (xO xH)))))
+                                                     (Zadd
+                                                        (Zadd
+                                                           (Zadd (Zadd (Zmul (Zmul x9 y5) (Zpos (xO xH))) (Zmul x8 y6))
+                                                              (Zmul (Zmul x7 y7) (Zpos (xO xH)))) (Zmul x6 y8))
+                                                        (Zmul (Zmul x5 y9) (Zpos (xO xH))))))) (Zpos (xO (xI (xO (xI xH))))))
+                                         (Zadd
+                                            (Zadd
+                                               (Zadd (Zadd (Zadd (Zadd (Zmul x5 y0) (Zmul x4 y1)) (Zmul x3 y2)) (Zmul x2 y3))
+                                                  (Zmul x1 y4)) (Zmul x0 y5))
+                                            (Zmul (Zpos (xI (xI (xO (xO xH)))))
+                                               (Zadd (Zadd (Zadd (Zmul x9 y6) (Zmul x8 y7)) (Zmul x7 y8)) (Zmul x6 y9)))))
+                                      (Zpos (xI (xO (xO (xI xH))))))
+                                   (Zadd
+                                      (Zadd
+                                         (Zadd
+                                            (Zadd
+                                               (Zadd (Zadd (Zadd (Zmul x6 y0) (Zmul (Zmul x5 y1) (Zpos (xO xH)))) (Zmul x4 y2))
+                                                  (Zmul (Zmul x3 y3) (Zpos (xO xH)))) (Zmul x2 y4))
+                                            (Zmul (Zmul x1 y5) (Zpos (xO xH)))) (Zmul x0 y6))
+                                      (Zmul (Zpos (xI (xI (xO (xO xH)))))
+                                         (Zadd (Zadd (Zmul (Zmul x9 y7) (Zpos (xO xH))) (Zmul x8 y8))
+                                            (Zmul (Zmul x7 y9) (Zpos (xO xH)))))))
+                                (Zpos
+                                   (xI
+                                      (xI
+                                         (xI
+                                            (xI
+                                               (xI
+                                                  (xI
+                                                     (xI
+                                                        (xI
+                                                           (xI
+                                                              (xI
+                                                                 (xI
+                                                                    (xI
+                                                                       (xI
+                                                                          (xI
+                                                                             (xI
+                                                                                (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI xH)))))))))))))))))))))))))))
+                             (@cons Z
+                                (Z.land
+                                   (Zadd
+                                      (Z.shiftr
+                                         (Zadd
+                                            (Z.shiftr
+                                               (Zadd
+                                                  (Z.shiftr
+                                                     (Zadd
+                                                        (Z.shiftr
+                                                           (Zadd
+                                                              (Z.shiftr
+                                                                 (Zadd
+                                                                    (Z.shiftr
+                                                                       (Zadd
+                                                                          (Z.shiftr
+                                                                             (Zadd (Zmul x0 y0)
+                                                                                (Zmul (Zpos (xI (xI (xO (xO xH)))))
+                                                                                   (Zadd
+                                                                                      (Zadd
+                                                                                         (Zadd
+                                                                                            (Zadd
+                                                                                               (Zadd
+                                                                                                  (Zadd
+                                                                                                     (Zadd
+                                                                                                       (Zadd
+                                                                                                       (Zmul
+                                                                                                       (Zmul x9 y1)
+                                                                                                       (Zpos (xO xH)))
+                                                                                                       (Zmul x8 y2))
+                                                                                                       (Zmul
+                                                                                                       (Zmul x7 y3)
+                                                                                                       (Zpos (xO xH))))
+                                                                                                     (Zmul x6 y4))
+                                                                                                  (Zmul (Zmul x5 y5) (Zpos (xO xH))))
+                                                                                               (Zmul x4 y6))
+                                                                                            (Zmul (Zmul x3 y7) (Zpos (xO xH))))
+                                                                                         (Zmul x2 y8))
+                                                                                      (Zmul (Zmul x1 y9) (Zpos (xO xH))))))
+                                                                             (Zpos (xO (xI (xO (xI xH))))))
+                                                                          (Zadd (Zadd (Zmul x1 y0) (Zmul x0 y1))
+                                                                             (Zmul (Zpos (xI (xI (xO (xO xH)))))
+                                                                                (Zadd
+                                                                                   (Zadd
+                                                                                      (Zadd
+                                                                                         (Zadd
+                                                                                            (Zadd
+                                                                                               (Zadd
+                                                                                                  (Zadd (Zmul x9 y2) (Zmul x8 y3))
+                                                                                                  (Zmul x7 y4))
+                                                                                               (Zmul x6 y5))
+                                                                                            (Zmul x5 y6))
+                                                                                         (Zmul x4 y7)) (Zmul x3 y8))
+                                                                                   (Zmul x2 y9))))) (Zpos (xI (xO (xO (xI xH))))))
+                                                                    (Zadd
+                                                                       (Zadd (Zadd (Zmul x2 y0) (Zmul (Zmul x1 y1) (Zpos (xO xH))))
+                                                                          (Zmul x0 y2))
+                                                                       (Zmul (Zpos (xI (xI (xO (xO xH)))))
+                                                                          (Zadd
+                                                                             (Zadd
+                                                                                (Zadd
+                                                                                   (Zadd
+                                                                                      (Zadd
+                                                                                         (Zadd (Zmul (Zmul x9 y3) (Zpos (xO xH)))
+                                                                                            (Zmul x8 y4))
+                                                                                         (Zmul (Zmul x7 y5) (Zpos (xO xH))))
+                                                                                      (Zmul x6 y6))
+                                                                                   (Zmul (Zmul x5 y7) (Zpos (xO xH))))
+                                                                                (Zmul x4 y8)) (Zmul (Zmul x3 y9) (Zpos (xO xH)))))))
+                                                                 (Zpos (xO (xI (xO (xI xH))))))
+                                                              (Zadd
+                                                                 (Zadd (Zadd (Zadd (Zmul x3 y0) (Zmul x2 y1)) (Zmul x1 y2))
+                                                                    (Zmul x0 y3))
+                                                                 (Zmul (Zpos (xI (xI (xO (xO xH)))))
+                                                                    (Zadd
+                                                                       (Zadd
+                                                                          (Zadd (Zadd (Zadd (Zmul x9 y4) (Zmul x8 y5)) (Zmul x7 y6))
+                                                                             (Zmul x6 y7)) (Zmul x5 y8))
+                                                                       (Zmul x4 y9))))) (Zpos (xI (xO (xO (xI xH))))))
+                                                        (Zadd
+                                                           (Zadd
+                                                              (Zadd
+                                                                 (Zadd (Zadd (Zmul x4 y0) (Zmul (Zmul x3 y1) (Zpos (xO xH))))
+                                                                    (Zmul x2 y2)) (Zmul (Zmul x1 y3) (Zpos (xO xH))))
+                                                              (Zmul x0 y4))
+                                                           (Zmul (Zpos (xI (xI (xO (xO xH)))))
+                                                              (Zadd
+                                                                 (Zadd
+                                                                    (Zadd (Zadd (Zmul (Zmul x9 y5) (Zpos (xO xH))) (Zmul x8 y6))
+                                                                       (Zmul (Zmul x7 y7) (Zpos (xO xH))))
+                                                                    (Zmul x6 y8)) (Zmul (Zmul x5 y9) (Zpos (xO xH)))))))
+                                                     (Zpos (xO (xI (xO (xI xH))))))
+                                                  (Zadd
+                                                     (Zadd
+                                                        (Zadd
+                                                           (Zadd (Zadd (Zadd (Zmul x5 y0) (Zmul x4 y1)) (Zmul x3 y2)) (Zmul x2 y3))
+                                                           (Zmul x1 y4)) (Zmul x0 y5))
+                                                     (Zmul (Zpos (xI (xI (xO (xO xH)))))
+                                                        (Zadd (Zadd (Zadd (Zmul x9 y6) (Zmul x8 y7)) (Zmul x7 y8)) (Zmul x6 y9)))))
+                                               (Zpos (xI (xO (xO (xI xH))))))
+                                            (Zadd
+                                               (Zadd
+                                                  (Zadd
+                                                     (Zadd
+                                                        (Zadd
+                                                           (Zadd (Zadd (Zmul x6 y0) (Zmul (Zmul x5 y1) (Zpos (xO xH)))) (Zmul x4 y2))
+                                                           (Zmul (Zmul x3 y3) (Zpos (xO xH)))) (Zmul x2 y4))
+                                                     (Zmul (Zmul x1 y5) (Zpos (xO xH)))) (Zmul x0 y6))
+                                               (Zmul (Zpos (xI (xI (xO (xO xH)))))
+                                                  (Zadd (Zadd (Zmul (Zmul x9 y7) (Zpos (xO xH))) (Zmul x8 y8))
+                                                     (Zmul (Zmul x7 y9) (Zpos (xO xH))))))) (Zpos (xO (xI (xO (xI xH))))))
+                                      (Zadd
+                                         (Zadd
+                                            (Zadd
+                                               (Zadd
+                                                  (Zadd (Zadd (Zadd (Zadd (Zmul x7 y0) (Zmul x6 y1)) (Zmul x5 y2)) (Zmul x4 y3))
+                                                     (Zmul x3 y4)) (Zmul x2 y5)) (Zmul x1 y6)) (Zmul x0 y7))
+                                         (Zmul (Zpos (xI (xI (xO (xO xH))))) (Zadd (Zmul x9 y8) (Zmul x8 y9)))))
+                                   (Zpos
+                                      (xI
+                                         (xI
+                                            (xI
+                                               (xI
+                                                  (xI
+                                                     (xI
+                                                        (xI
+                                                           (xI
+                                                              (xI
+                                                                 (xI
+                                                                    (xI
+                                                                       (xI
+                                                                          (xI
+                                                                             (xI
+                                                                                (xI (xI (xI (xI (xI (xI (xI (xI (xI (xI xH))))))))))))))))))))))))))
+                                (@cons Z
+                                   (Z.land
+                                      (Zadd
+                                         (Z.shiftr
+                                            (Zadd
+                                               (Z.shiftr
+                                                  (Zadd
+                                                     (Z.shiftr
+                                                        (Zadd
+                                                           (Z.shiftr
+                                                              (Zadd
+                                                                 (Z.shiftr
+                                                                    (Zadd
+                                                                       (Z.shiftr
+                                                                          (Zadd
+                                                                             (Z.shiftr
+                                                                                (Zadd
+                                                                                   (Z.shiftr
+                                                                                      (Zadd (Zmul x0 y0)
+                                                                                         (Zmul (Zpos (xI (xI (xO (xO xH)))))
+                                                                                            (Zadd
+                                                                                               (Zadd
+                                                                                                  (Zadd
+                                                                                                     (Zadd
+                                                                                                       (Zadd
+                                                                                                       (Zadd
+                                                                                                       (Zadd
+                                                                                                       (Zadd
+                                                                                                       (Zmul
+                                                                                                       (Zmul x9 y1)
+                                                                                                       (Zpos (xO xH)))
+                                                                                                       (Zmul x8 y2))
+                                                                                                       (Zmul
+                                                                                                       (Zmul x7 y3)
+                                                                                                       (Zpos (xO xH))))
+                                                                                                       (Zmul x6 y4))
+                                                                                                       (Zmul
+                                                                                                       (Zmul x5 y5)
+                                                                                                       (Zpos (xO xH))))
+                                                                                                       (Zmul x4 y6))
+                                                                                                     (Zmul
+                                                                                                       (Zmul x3 y7)
+                                                                                                       (Zpos (xO xH))))
+                                                                                                  (Zmul x2 y8))
+                                                                                               (Zmul (Zmul x1 y9) (Zpos (xO xH))))))
+                                                                                      (Zpos (xO (xI (xO (xI xH))))))
+                                                                                   (Zadd (Zadd (Zmul x1 y0) (Zmul x0 y1))
+                                                                                      (Zmul (Zpos (xI (xI (xO (xO xH)))))
+                                                                                         (Zadd
+                                                                                            (Zadd
+                                                                                               (Zadd
+                                                                                                  (Zadd
+                                                                                                     (Zadd
+                                                                                                       (Zadd
+                                                                                                       (Zadd
+                                                                                                       (Zmul x9 y2)
+                                                                                                       (Zmul x8 y3))
+                                                                                                       (Zmul x7 y4))
+                                                                                                       (Zmul x6 y5))
+                                                                                                     (Zmul x5 y6))
+                                                                                                  (Zmul x4 y7))
+                                                                                               (Zmul x3 y8))
+                                                                                            (Zmul x2 y9)))))
+                                                                                (Zpos (xI (xO (xO (xI xH))))))
+                                                                             (Zadd
+                                                                                (Zadd
+                                                                                   (Zadd (Zmul x2 y0)
+                                                                                      (Zmul (Zmul x1 y1) (Zpos (xO xH))))
+                                                                                   (Zmul x0 y2))
+                                                                                (Zmul (Zpos (xI (xI (xO (xO xH)))))
+                                                                                   (Zadd
+                                                                                      (Zadd
+                                                                                         (Zadd
+                                                                                            (Zadd
+                                                                                               (Zadd
+                                                                                                  (Zadd
+                                                                                                     (Zmul
+                                                                                                       (Zmul x9 y3)
+                                                                                                       (Zpos (xO xH)))
+                                                                                                     (Zmul x8 y4))
+                                                                                                  (Zmul (Zmul x7 y5) (Zpos (xO xH))))
+                                                                                               (Zmul x6 y6))
+                                                                                            (Zmul (Zmul x5 y7) (Zpos (xO xH))))
+                                                                                         (Zmul x4 y8))
+                                                                                      (Zmul (Zmul x3 y9) (Zpos (xO xH)))))))
+                                                                          (Zpos (xO (xI (xO (xI xH))))))
+                                                                       (Zadd
+                                                                          (Zadd (Zadd (Zadd (Zmul x3 y0) (Zmul x2 y1)) (Zmul x1 y2))
+                                                                             (Zmul x0 y3))
+                                                                          (Zmul (Zpos (xI (xI (xO (xO xH)))))
+                                                                             (Zadd
+                                                                                (Zadd
+                                                                                   (Zadd
+                                                                                      (Zadd (Zadd (Zmul x9 y4) (Zmul x8 y5))
+                                                                                         (Zmul x7 y6)) (Zmul x6 y7))
+                                                                                   (Zmul x5 y8)) (Zmul x4 y9)))))
+                                                                    (Zpos (xI (xO (xO (xI xH))))))
+                                                                 (Zadd
+                                                                    (Zadd
+                                                                       (Zadd
+                                                                          (Zadd
+                                                                             (Zadd (Zmul x4 y0) (Zmul (Zmul x3 y1) (Zpos (xO xH))))
+                                                                             (Zmul x2 y2)) (Zmul (Zmul x1 y3) (Zpos (xO xH))))
+                                                                       (Zmul x0 y4))
+                                                                    (Zmul (Zpos (xI (xI (xO (xO xH)))))
+                                                                       (Zadd
+                                                                          (Zadd
+                                                                             (Zadd
+                                                                                (Zadd (Zmul (Zmul x9 y5) (Zpos (xO xH)))
+                                                                                   (Zmul x8 y6)) (Zmul (Zmul x7 y7) (Zpos (xO xH))))
+                                                                             (Zmul x6 y8)) (Zmul (Zmul x5 y9) (Zpos (xO xH)))))))
+                                                              (Zpos (xO (xI (xO (xI xH))))))
+                                                           (Zadd
+                                                              (Zadd
+                                                                 (Zadd
+                                                                    (Zadd (Zadd (Zadd (Zmul x5 y0) (Zmul x4 y1)) (Zmul x3 y2))
+                                                                       (Zmul x2 y3)) (Zmul x1 y4)) (Zmul x0 y5))
+                                                              (Zmul (Zpos (xI (xI (xO (xO xH)))))
+                                                                 (Zadd (Zadd (Zadd (Zmul x9 y6) (Zmul x8 y7)) (Zmul x7 y8))
+                                                                    (Zmul x6 y9))))) (Zpos (xI (xO (xO (xI xH))))))
+                                                     (Zadd
+                                                        (Zadd
+                                                           (Zadd
+                                                              (Zadd
+                                                                 (Zadd
+                                                                    (Zadd (Zadd (Zmul x6 y0) (Zmul (Zmul x5 y1) (Zpos (xO xH))))
+                                                                       (Zmul x4 y2)) (Zmul (Zmul x3 y3) (Zpos (xO xH))))
+                                                                 (Zmul x2 y4)) (Zmul (Zmul x1 y5) (Zpos (xO xH))))
+                                                           (Zmul x0 y6))
+                                                        (Zmul (Zpos (xI (xI (xO (xO xH)))))
+                                                           (Zadd (Zadd (Zmul (Zmul x9 y7) (Zpos (xO xH))) (Zmul x8 y8))
+                                                              (Zmul (Zmul x7 y9) (Zpos (xO xH))))))) (Zpos (xO (xI (xO (xI xH))))))
+                                               (Zadd
+                                                  (Zadd
+                                                     (Zadd
+                                                        (Zadd
+                                                           (Zadd
+                                                              (Zadd (Zadd (Zadd (Zmul x7 y0) (Zmul x6 y1)) (Zmul x5 y2))
+                                                                 (Zmul x4 y3)) (Zmul x3 y4)) (Zmul x2 y5))
+                                                        (Zmul x1 y6)) (Zmul x0 y7))
+                                                  (Zmul (Zpos (xI (xI (xO (xO xH))))) (Zadd (Zmul x9 y8) (Zmul x8 y9)))))
+                                            (Zpos (xI (xO (xO (xI xH))))))
+                                         (Zadd
+                                            (Zadd
+                                               (Zadd
+                                                  (Zadd
+                                                     (Zadd
+                                                        (Zadd
+                                                           (Zadd
+                                                              (Zadd (Zadd (Zmul x8 y0) (Zmul (Zmul x7 y1) (Zpos (xO xH))))
+                                                                 (Zmul x6 y2)) (Zmul (Zmul x5 y3) (Zpos (xO xH))))
+                                                           (Zmul x4 y4)) (Zmul (Zmul x3 y5) (Zpos (xO xH))))
+                                                     (Zmul x2 y6)) (Zmul (Zmul x1 y7) (Zpos (xO xH)))) (Zmul x0 y8))
+                                            (Zmul (Zmul (Zmul (Zpos (xI (xI (xO (xO xH))))) x9) y9) (Zpos (xO xH)))))
+                                      (Zpos
+                                         (xI
+                                            (xI
+                                               (xI
+                                                  (xI
+                                                     (xI
+                                                        (xI
+                                                           (xI
+                                                              (xI
+                                                                 (xI
+                                                                    (xI
+                                                                       (xI
+                                                                          (xI
+                                                                             (xI
+                                                                                (xI
+                                                                                   (xI
+                                                                                      (xI
+                                                                                         (xI
+                                                                                            (xI
+                                                                                               (xI (xI (xI (xI (xI (xI (xI xH)))))))))))))))))))))))))))
+                                   (@cons Z
+                                      (Z.land
+                                         (Zadd
+                                            (Z.shiftr
+                                               (Zadd
+                                                  (Z.shiftr
+                                                     (Zadd
+                                                        (Z.shiftr
+                                                           (Zadd
+                                                              (Z.shiftr
+                                                                 (Zadd
+                                                                    (Z.shiftr
+                                                                       (Zadd
+                                                                          (Z.shiftr
+                                                                             (Zadd
+                                                                                (Z.shiftr
+                                                                                   (Zadd
+                                                                                      (Z.shiftr
+                                                                                         (Zadd
+                                                                                            (Z.shiftr
+                                                                                               (Zadd (Zmul x0 y0)
+                                                                                                  (Zmul
+                                                                                                     (Zpos (xI (xI (xO (xO xH)))))
+                                                                                                     (Zadd
+                                                                                                       (Zadd
+                                                                                                       (Zadd
+                                                                                                       (Zadd
+                                                                                                       (Zadd
+                                                                                                       (Zadd
+                                                                                                       (Zadd
+                                                                                                       (Zadd
+                                                                                                       (Zmul
+                                                                                                       (Zmul x9 y1)
+                                                                                                       (Zpos (xO xH)))
+                                                                                                       (Zmul x8 y2))
+                                                                                                       (Zmul
+                                                                                                       (Zmul x7 y3)
+                                                                                                       (Zpos (xO xH))))
+                                                                                                       (Zmul x6 y4))
+                                                                                                       (Zmul
+                                                                                                       (Zmul x5 y5)
+                                                                                                       (Zpos (xO xH))))
+                                                                                                       (Zmul x4 y6))
+                                                                                                       (Zmul
+                                                                                                       (Zmul x3 y7)
+                                                                                                       (Zpos (xO xH))))
+                                                                                                       (Zmul x2 y8))
+                                                                                                       (Zmul
+                                                                                                       (Zmul x1 y9)
+                                                                                                       (Zpos (xO xH))))))
+                                                                                               (Zpos (xO (xI (xO (xI xH))))))
+                                                                                            (Zadd (Zadd (Zmul x1 y0) (Zmul x0 y1))
+                                                                                               (Zmul (Zpos (xI (xI (xO (xO xH)))))
+                                                                                                  (Zadd
+                                                                                                     (Zadd
+                                                                                                       (Zadd
+                                                                                                       (Zadd
+                                                                                                       (Zadd
+                                                                                                       (Zadd
+                                                                                                       (Zadd
+                                                                                                       (Zmul x9 y2)
+                                                                                                       (Zmul x8 y3))
+                                                                                                       (Zmul x7 y4))
+                                                                                                       (Zmul x6 y5))
+                                                                                                       (Zmul x5 y6))
+                                                                                                       (Zmul x4 y7))
+                                                                                                       (Zmul x3 y8))
+                                                                                                     (Zmul x2 y9)))))
+                                                                                         (Zpos (xI (xO (xO (xI xH))))))
+                                                                                      (Zadd
+                                                                                         (Zadd
+                                                                                            (Zadd (Zmul x2 y0)
+                                                                                               (Zmul (Zmul x1 y1) (Zpos (xO xH))))
+                                                                                            (Zmul x0 y2))
+                                                                                         (Zmul (Zpos (xI (xI (xO (xO xH)))))
+                                                                                            (Zadd
+                                                                                               (Zadd
+                                                                                                  (Zadd
+                                                                                                     (Zadd
+                                                                                                       (Zadd
+                                                                                                       (Zadd
+                                                                                                       (Zmul
+                                                                                                       (Zmul x9 y3)
+                                                                                                       (Zpos (xO xH)))
+                                                                                                       (Zmul x8 y4))
+                                                                                                       (Zmul
+                                                                                                       (Zmul x7 y5)
+                                                                                                       (Zpos (xO xH))))
+                                                                                                       (Zmul x6 y6))
+                                                                                                     (Zmul
+                                                                                                       (Zmul x5 y7)
+                                                                                                       (Zpos (xO xH))))
+                                                                                                  (Zmul x4 y8))
+                                                                                               (Zmul (Zmul x3 y9) (Zpos (xO xH)))))))
+                                                                                   (Zpos (xO (xI (xO (xI xH))))))
+                                                                                (Zadd
+                                                                                   (Zadd
+                                                                                      (Zadd (Zadd (Zmul x3 y0) (Zmul x2 y1))
+                                                                                         (Zmul x1 y2)) (Zmul x0 y3))
+                                                                                   (Zmul (Zpos (xI (xI (xO (xO xH)))))
+                                                                                      (Zadd
+                                                                                         (Zadd
+                                                                                            (Zadd
+                                                                                               (Zadd
+                                                                                                  (Zadd (Zmul x9 y4) (Zmul x8 y5))
+                                                                                                  (Zmul x7 y6))
+                                                                                               (Zmul x6 y7))
+                                                                                            (Zmul x5 y8))
+                                                                                         (Zmul x4 y9)))))
+                                                                             (Zpos (xI (xO (xO (xI xH))))))
+                                                                          (Zadd
+                                                                             (Zadd
+                                                                                (Zadd
+                                                                                   (Zadd
+                                                                                      (Zadd (Zmul x4 y0)
+                                                                                         (Zmul (Zmul x3 y1) (Zpos (xO xH))))
+                                                                                      (Zmul x2 y2))
+                                                                                   (Zmul (Zmul x1 y3) (Zpos (xO xH))))
+                                                                                (Zmul x0 y4))
+                                                                             (Zmul (Zpos (xI (xI (xO (xO xH)))))
+                                                                                (Zadd
+                                                                                   (Zadd
+                                                                                      (Zadd
+                                                                                         (Zadd (Zmul (Zmul x9 y5) (Zpos (xO xH)))
+                                                                                            (Zmul x8 y6))
+                                                                                         (Zmul (Zmul x7 y7) (Zpos (xO xH))))
+                                                                                      (Zmul x6 y8))
+                                                                                   (Zmul (Zmul x5 y9) (Zpos (xO xH)))))))
+                                                                       (Zpos (xO (xI (xO (xI xH))))))
+                                                                    (Zadd
+                                                                       (Zadd
+                                                                          (Zadd
+                                                                             (Zadd
+                                                                                (Zadd (Zadd (Zmul x5 y0) (Zmul x4 y1)) (Zmul x3 y2))
+                                                                                (Zmul x2 y3)) (Zmul x1 y4))
+                                                                          (Zmul x0 y5))
+                                                                       (Zmul (Zpos (xI (xI (xO (xO xH)))))
+                                                                          (Zadd (Zadd (Zadd (Zmul x9 y6) (Zmul x8 y7)) (Zmul x7 y8))
+                                                                             (Zmul x6 y9))))) (Zpos (xI (xO (xO (xI xH))))))
+                                                              (Zadd
+                                                                 (Zadd
+                                                                    (Zadd
+                                                                       (Zadd
+                                                                          (Zadd
+                                                                             (Zadd
+                                                                                (Zadd (Zmul x6 y0)
+                                                                                   (Zmul (Zmul x5 y1) (Zpos (xO xH))))
+                                                                                (Zmul x4 y2)) (Zmul (Zmul x3 y3) (Zpos (xO xH))))
+                                                                          (Zmul x2 y4)) (Zmul (Zmul x1 y5) (Zpos (xO xH))))
+                                                                    (Zmul x0 y6))
+                                                                 (Zmul (Zpos (xI (xI (xO (xO xH)))))
+                                                                    (Zadd (Zadd (Zmul (Zmul x9 y7) (Zpos (xO xH))) (Zmul x8 y8))
+                                                                       (Zmul (Zmul x7 y9) (Zpos (xO xH)))))))
+                                                           (Zpos (xO (xI (xO (xI xH))))))
+                                                        (Zadd
+                                                           (Zadd
+                                                              (Zadd
+                                                                 (Zadd
+                                                                    (Zadd
+                                                                       (Zadd (Zadd (Zadd (Zmul x7 y0) (Zmul x6 y1)) (Zmul x5 y2))
+                                                                          (Zmul x4 y3)) (Zmul x3 y4)) (Zmul x2 y5))
+                                                                 (Zmul x1 y6)) (Zmul x0 y7))
+                                                           (Zmul (Zpos (xI (xI (xO (xO xH))))) (Zadd (Zmul x9 y8) (Zmul x8 y9)))))
+                                                     (Zpos (xI (xO (xO (xI xH))))))
+                                                  (Zadd
+                                                     (Zadd
+                                                        (Zadd
+                                                           (Zadd
+                                                              (Zadd
+                                                                 (Zadd
+                                                                    (Zadd
+                                                                       (Zadd (Zadd (Zmul x8 y0) (Zmul (Zmul x7 y1) (Zpos (xO xH))))
+                                                                          (Zmul x6 y2)) (Zmul (Zmul x5 y3) (Zpos (xO xH))))
+                                                                    (Zmul x4 y4)) (Zmul (Zmul x3 y5) (Zpos (xO xH))))
+                                                              (Zmul x2 y6)) (Zmul (Zmul x1 y7) (Zpos (xO xH))))
+                                                        (Zmul x0 y8))
+                                                     (Zmul (Zmul (Zmul (Zpos (xI (xI (xO (xO xH))))) x9) y9) (Zpos (xO xH)))))
+                                               (Zpos (xO (xI (xO (xI xH))))))
+                                            (Zadd
+                                               (Zadd
+                                                  (Zadd
+                                                     (Zadd
+                                                        (Zadd
+                                                           (Zadd
+                                                              (Zadd (Zadd (Zadd (Zmul x9 y0) (Zmul x8 y1)) (Zmul x7 y2))
+                                                                 (Zmul x6 y3)) (Zmul x5 y4)) (Zmul x4 y5))
+                                                        (Zmul x3 y6)) (Zmul x2 y7)) (Zmul x1 y8)) (Zmul x0 y9)))
+                                         (Zpos
+                                            (xI
+                                               (xI
+                                                  (xI
+                                                     (xI
+                                                        (xI
+                                                           (xI
+                                                              (xI
+                                                                 (xI
+                                                                    (xI
+                                                                       (xI
+                                                                          (xI
+                                                                             (xI
+                                                                                (xI
+                                                                                   (xI
+                                                                                      (xI
+                                                                                         (xI
+                                                                                            (xI
+                                                                                               (xI (xI (xI (xI (xI (xI (xI xH))))))))))))))))))))))))))
+                                      (@nil Z)))))))))))).
+  cbv beta zeta.
+  intros.
+  (timeout 1 (apply f_equal; reflexivity)) || fail 0 "too early".
+  Undo.
+  Time Timeout 1 f_equal. (* Finished transaction in 0. secs (0.3u,0.s) in 8.4 *)
diff --git a/test-suite/bugs/closed/4813.v b/test-suite/bugs/closed/4813.v
new file mode 100644
index 000000000..5f8ea74c1
--- /dev/null
+++ b/test-suite/bugs/closed/4813.v
@@ -0,0 +1,9 @@
+(* On the strength of "apply with" (see also #4782) *)
+
+Record ProverT := { Facts : Type }.
+Record ProverT_correct (P : ProverT) :=  { Valid : Facts P -> Prop ;
+                                           Valid_weaken : Valid = Valid }.
+Definition reflexivityValid (_ : unit) := True.
+Definition reflexivityProver_correct : ProverT_correct {| Facts := unit |}.
+Proof.
+    eapply Build_ProverT_correct with (Valid := reflexivityValid).
diff --git a/test-suite/bugs/closed/4816.v b/test-suite/bugs/closed/4816.v
new file mode 100644
index 000000000..00a523842
--- /dev/null
+++ b/test-suite/bugs/closed/4816.v
@@ -0,0 +1,29 @@
+Section foo.
+Polymorphic Universes A B.
+Fail Constraint A <= B.
+End foo.
+(* gives an anomaly Universe undefined *)
+
+Universes X Y.
+Section Foo.
+  Polymorphic Universes Z W.
+  Polymorphic Constraint W < Z.
+
+  Fail Definition bla := Type@{W}.
+  Polymorphic Definition bla := Type@{W}.
+  Section Bar.
+    Fail Constraint X <= Z.
+  End Bar.
+End Foo.
+
+Require Coq.Classes.RelationClasses.
+
+Class PreOrder (A : Type) (r : A -> A -> Type) : Type :=
+{ refl : forall x, r x x }.
+
+Section qux.
+  Polymorphic Universes A.
+  Section bar.
+    Fail Context {A : Type@{A}} {rA : A -> A -> Prop} {PO : PreOrder A rA}.
+  End bar.
+End qux.
diff --git a/test-suite/bugs/closed/4818.v b/test-suite/bugs/closed/4818.v
new file mode 100644
index 000000000..904abb228
--- /dev/null
+++ b/test-suite/bugs/closed/4818.v
@@ -0,0 +1,24 @@
+(* -*- mode: coq; coq-prog-args: ("-emacs" "-R" "." "Prob" "-top" "Product") -*- *)
+(* File reduced by coq-bug-finder from original input, then from 391 lines to 77 lines, then from 857 lines to 119 lines, then from 1584 lines to 126 lines, then from 362 lines to 135 lines, then from 149 lines to 135 lines *)
+(* coqc version 8.5pl1 (June 2016) compiled on Jun 9 2016 17:27:17 with OCaml 4.02.3
+   coqtop version 8.5pl1 (June 2016) *)
+Set Universe Polymorphism.
+
+Inductive GCov (I : Type) : Type := | Foo : I -> GCov I.
+
+Section Product.
+
+Variables S IS : Type.
+Variable locS : IS -> True.
+
+Goal GCov (IS * S) -> GCov IS.
+intros X0. induction X0; intros.
+destruct i.
+specialize (locS i).
+clear -locS. 
+destruct locS. Show Universes.
+Admitted.
+
+(*
+Anomaly: Universe Product.5189 undefined. Please report.
+*)
diff --git a/test-suite/bugs/closed/4858.v b/test-suite/bugs/closed/4858.v
new file mode 100644
index 000000000..a2fa93832
--- /dev/null
+++ b/test-suite/bugs/closed/4858.v
@@ -0,0 +1,7 @@
+Require Import Nsatz.
+Goal True.
+try nsatz_compute
+ (PEc 0%Z :: PEc (-1)%Z
+    :: PEpow (PEsub (PEX Z 2) (PEX Z 3)) 1
+       :: PEsub (PEX Z 1) (PEX Z 1) :: nil).
+Abort.
diff --git a/test-suite/bugs/closed/4863.v b/test-suite/bugs/closed/4863.v
new file mode 100644
index 000000000..1e47f2957
--- /dev/null
+++ b/test-suite/bugs/closed/4863.v
@@ -0,0 +1,33 @@
+Require Import Classes.DecidableClass.
+
+Inductive Foo : Set :=
+| foo1 | foo2.
+
+Lemma Decidable_sumbool : forall P, {P}+{~P} -> Decidable P.
+Proof.
+  intros P H.
+  refine (Build_Decidable _ (if H then true else false) _).
+  intuition congruence.
+Qed.
+
+Hint Extern 100 (Decidable (?A = ?B)) => abstract (abstract (abstract (apply Decidable_sumbool; decide equality))) : typeclass_instances.
+
+Goal forall (a b : Foo), {a=b}+{a<>b}.
+intros.
+abstract (abstract (decide equality)). (*abstract works here*)
+Qed.
+
+Check ltac:(abstract (exact I)) : True.
+
+Goal forall (a b : Foo), Decidable (a=b) * Decidable (a=b).
+intros.
+split. typeclasses eauto. 
+typeclasses eauto. Qed.
+
+Goal forall (a b : Foo), Decidable (a=b) * Decidable (a=b).
+intros.
+split.
+refine _.
+refine _.
+Defined.
+(*fails*)
diff --git a/test-suite/bugs/closed/4865.v b/test-suite/bugs/closed/4865.v
new file mode 100644
index 000000000..c5bf3289b
--- /dev/null
+++ b/test-suite/bugs/closed/4865.v
@@ -0,0 +1,52 @@
+(* Check discharge of arguments scopes + other checks *)
+
+(* This is bug #4865 *)
+
+Notation "<T>" := true : bool_scope.
+Section A.
+  Check negb <T>.
+  Global Arguments negb : clear scopes.
+  Fail Check negb <T>.
+End A.
+
+(* Check that no scope is re-computed *)
+Fail Check negb <T>.
+
+(* Another test about arguments scopes in sections *)
+
+Notation "0" := true.
+Section B.
+  Variable x : nat.
+  Let T := nat -> nat.
+  Definition f y : T := fun z => x + y + z.
+  Fail Check f 1 0.   (* 0 in nat, 0 in bool *)
+  Fail Check f 0 0.   (* 0 in nat, 0 in bool *)
+  Check f 0 1.        (* 0 and 1 in nat *)
+  Global Arguments f _%nat_scope _%nat_scope.
+  Check f 0 0.        (* both 0 in nat *)
+End B.
+
+(* Check that only the scope for the extra product on x is re-computed *)
+Check f 0 0 0.   (* All 0 in nat *)
+
+Section C.
+  Variable x : nat.
+  Let T := nat -> nat.
+  Definition g y : T := fun z => x + y + z.
+  Global Arguments g : clear scopes.
+  Check g 1.          (* 1 in nat *)
+End C.
+
+(* Check that only the scope for the extra product on x is re-computed *)
+Check g 0.            (* 0 in nat *)
+Fail Check g 0 1 0. (* 2nd 0 in bool *)
+Fail Check g 0 0 1. (* 2nd 0 in bool *)
+
+(* Another test on arguments scopes: checking scope for expanding arities *)
+(* Not sure this is very useful, but why not *)
+                  
+Fixpoint arr n := match n with 0%nat => nat | S n => nat -> arr n end.
+Fixpoint lam n : arr n := match n with 0%nat => 0%nat | S n => fun x => lam n  end.
+Notation "0" := true.
+Arguments Scope lam [nat_scope nat_scope].
+Check (lam 1 0).
diff --git a/test-suite/bugs/closed/4869.v b/test-suite/bugs/closed/4869.v
new file mode 100644
index 000000000..6d21b66fe
--- /dev/null
+++ b/test-suite/bugs/closed/4869.v
@@ -0,0 +1,18 @@
+Universes i.
+
+Fail Constraint i < Set.
+Fail Constraint i <= Set.
+Fail Constraint i = Set.
+Constraint Set <= i.
+Constraint Set < i.
+Fail Constraint i < j. (* undeclared j *)
+Fail Constraint i < Type. (* anonymous *)
+
+Set Universe Polymorphism.
+
+Section Foo.
+  Universe j.
+  Constraint Set < j.
+
+  Definition foo := Type@{j}.
+End Foo.
\ No newline at end of file
diff --git a/test-suite/bugs/closed/4873.v b/test-suite/bugs/closed/4873.v
new file mode 100644
index 000000000..f2f917b4e
--- /dev/null
+++ b/test-suite/bugs/closed/4873.v
@@ -0,0 +1,72 @@
+Require Import Coq.Classes.Morphisms.
+Require Import Relation_Definitions.
+Require Import Coq.Compat.Coq85.
+
+Fixpoint tuple' T n : Type :=
+  match n with
+  | O => T
+  | S n' => (tuple' T n' * T)%type
+  end.
+
+Definition tuple T n : Type :=
+  match n with
+  | O => unit
+  | S n' => tuple' T n'
+  end.
+
+Fixpoint to_list' {T} (n:nat) {struct n} : tuple' T n -> list T :=
+  match n with
+  | 0 => fun x => (x::nil)%list
+  | S n' => fun xs : tuple' T (S n') => let (xs', x) := xs in (x :: to_list' n' xs')%list
+  end.
+
+Definition to_list {T} (n:nat) : tuple T n -> list T :=
+  match n with
+  | 0 => fun _ => nil
+  | S n' => fun xs : tuple T (S n') => to_list' n' xs
+  end.
+
+Program Fixpoint from_list' {T} (y:T) (n:nat) (xs:list T) : length xs = n -> tuple' T n :=
+  match n return _ with
+  | 0 =>
+    match xs return (length xs = 0 -> tuple' T 0) with
+    | nil => fun _ => y
+    | _ => _ (* impossible *)
+    end
+  | S n' =>
+    match xs return (length xs = S n' -> tuple' T (S n')) with
+    | cons x xs' => fun _ => (from_list' x n' xs' _, y)
+    | _ => _ (* impossible *)
+    end
+  end.
+Goal True.
+  pose from_list'_obligation_3 as e.
+  repeat (let e' := fresh in
+          rename e into e';
+          (pose (e' nat) as e || pose (e' 0) as e || pose (e' nil) as e || pose (e' eq_refl) as e);
+          subst e').
+  progress hnf in e.
+  pose (eq_refl : e = eq_refl).
+  exact I.
+Qed.
+
+Program Definition from_list {T} (n:nat) (xs:list T) : length xs = n -> tuple T n :=
+match n return _ with
+| 0 =>
+    match xs return (length xs = 0 -> tuple T 0) with
+    | nil => fun _ : 0 = 0 => tt
+    | _ => _ (* impossible *)
+    end
+| S n' =>
+    match xs return (length xs = S n' -> tuple T (S n')) with
+    | cons x xs' => fun _ => from_list' x n' xs' _
+    | _ => _ (* impossible *)
+    end
+end.
+
+Lemma to_list_from_list : forall {T} (n:nat) (xs:list T) pf, to_list n (from_list n xs pf) = xs.
+Proof.
+  destruct xs; simpl; intros; subst; auto.
+  generalize dependent t. simpl in *.
+  induction xs; simpl in *; intros; congruence.
+Qed.
\ No newline at end of file
diff --git a/test-suite/bugs/closed/4877.v b/test-suite/bugs/closed/4877.v
new file mode 100644
index 000000000..7e3c78dc2
--- /dev/null
+++ b/test-suite/bugs/closed/4877.v
@@ -0,0 +1,12 @@
+Ltac induction_last :=
+  let v := match goal with
+           | |- forall x y, _ = _ -> _ => 1
+           | |- forall x y, _ -> _ = _ -> _ => 2
+           | |- forall x y, _ -> _ -> _ = _ -> _ => 3
+           end in
+  induction v.
+
+Goal forall n m : nat, True -> n = m -> m = n.
+  induction_last.
+  reflexivity.
+Qed.
\ No newline at end of file
diff --git a/test-suite/bugs/closed/4880.v b/test-suite/bugs/closed/4880.v
new file mode 100644
index 000000000..5569798d5
--- /dev/null
+++ b/test-suite/bugs/closed/4880.v
@@ -0,0 +1,11 @@
+Require Import Coq.Reals.Reals Coq.nsatz.Nsatz.
+Local Open Scope R.
+
+Goal forall x y : R,
+  x*x =  y *  y ->
+  x*x = -y * -y ->
+  x*(x*x) = 0 -> (* The associativity does not actually matter, *)
+  (x*x)*x = 0.   (* just otherwise [assumption] would solve the goal. *)
+Proof.
+  nsatz.
+Qed.
diff --git a/test-suite/bugs/closed/4882.v b/test-suite/bugs/closed/4882.v
new file mode 100644
index 000000000..8c26af708
--- /dev/null
+++ b/test-suite/bugs/closed/4882.v
@@ -0,0 +1,50 @@
+
+Definition Foo {T}{a : T} : T := a.
+
+Module A.
+
+  Declare Implicit Tactic eauto.
+
+  Goal forall A (x : A), A.
+  intros.
+  apply Foo. (* Check defined evars are normalized *)
+  (*  Qed. *)
+  Abort.
+
+End A.
+
+Module B.
+
+  Definition Foo {T}{a : T} : T := a.
+
+  Declare Implicit Tactic eassumption.
+
+  Goal forall A (x : A), A.
+  intros.
+  apply Foo.
+  (*  Qed. *)
+  Abort.
+
+End B.
+
+Module C.
+
+  Declare Implicit Tactic first [exact True|assumption].
+
+  Goal forall (x : True), True.
+  intros.
+  apply (@Foo _ _).
+  Qed.
+
+End C.
+
+Module D.
+
+  Declare Implicit Tactic assumption.
+
+  Goal forall A (x : A), A.
+  intros.
+  exact _.
+  Qed.
+
+End D.
diff --git a/test-suite/bugs/closed/4893.v b/test-suite/bugs/closed/4893.v
new file mode 100644
index 000000000..9a35bcf95
--- /dev/null
+++ b/test-suite/bugs/closed/4893.v
@@ -0,0 +1,4 @@
+Goal True.
+evar (P: Prop).
+assert (H : P); [|subst P]; [exact I|].
+let T := type of H in not_evar T.
diff --git a/test-suite/bugs/closed/4904.v b/test-suite/bugs/closed/4904.v
new file mode 100644
index 000000000..a47c3b07a
--- /dev/null
+++ b/test-suite/bugs/closed/4904.v
@@ -0,0 +1,11 @@
+Module A.
+Module B.
+Notation mynat := nat.
+Notation nat := nat.
+End B.
+End A.
+
+Print A.B.nat. (* Notation A.B.nat := nat *)
+Import A.
+Print B.mynat.
+Print B.nat.
diff --git a/test-suite/bugs/closed/4932.v b/test-suite/bugs/closed/4932.v
new file mode 100644
index 000000000..219d532ac
--- /dev/null
+++ b/test-suite/bugs/closed/4932.v
@@ -0,0 +1,44 @@
+(* Testing recursive notations with binders seen as terms *)
+
+Inductive ftele : Type :=
+| fb {T:Type} : T -> ftele
+| fr {T} : (T -> ftele) -> ftele.
+
+Fixpoint args ftele : Type :=
+  match ftele with
+    | fb _ => unit
+    | fr f => sigT (fun t => args (f t))
+  end.
+
+Definition fpack := sigT args.
+Definition pack fp fa : fpack := existT _ fp fa.
+
+Notation "'tele' x .. z := b" :=
+  (
+    (fun x => ..
+                (fun z =>
+                   pack
+                     (fr (fun x => .. ( fr (fun z => fb b) ) .. ) )
+                     (existT _ x .. (existT _ z tt) .. )
+                ) ..
+    )
+  ) (at level 85, x binder, z binder).
+
+Check fun '((y,z):nat*nat) => pack (fr (fun '((y,z):nat*nat) => fb tt))
+                                   (existT _ (y,z) tt).
+
+Example test := tele (t : Type) := tt.
+Example test' := test nat.
+Print test.
+
+Example test2 := tele (t : Type) (x:t) := tt.
+Example test2' := test2 nat 0.
+Print test2.
+
+Example test3 := tele (t : Type) (y:=0) (x:t) := tt.
+Example test3' := test3 nat 0.
+Print test3.
+
+Example test4 := tele (t : Type) '((y,z):nat*nat) (x:t) := tt.
+Example test4' := test4 nat (1,2) 3.
+Print test4.
diff --git a/test-suite/bugs/closed/4955.v b/test-suite/bugs/closed/4955.v
new file mode 100644
index 000000000..dce1f764c
--- /dev/null
+++ b/test-suite/bugs/closed/4955.v
@@ -0,0 +1,98 @@
+(* An example involving a first-order unification triggering a cyclic constraint *)
+
+Module A.
+Notation "{ x : A | P }" := (sigT (fun x:A => P)).
+Notation "( x ; y )" := (existT _ x y) : fibration_scope.
+Open Scope fibration_scope.
+Notation "p @ q" := (eq_trans p q) (at level 20).
+Notation "p ^" := (eq_sym p) (at level 3).
+Definition transport {A : Type} (P : A -> Type) {x y : A} (p : x = y) (u : P x) 
+: P y :=
+  match p with eq_refl => u end.
+Notation "p # x" := (transport _ p x) (right associativity, at level 65, only 
+parsing).
+Definition ap {A B:Type} (f:A -> B) {x y:A} (p:x = y) : f x = f y
+  := match p with eq_refl => eq_refl end.
+Definition apD {A:Type} {B:A->Type} (f:forall a:A, B a) {x y:A} (p:x=y): p # (f 
+x) = f y
+  := match p with eq_refl => eq_refl end.
+Axiom transport_compose
+  : forall {A B} {x y : A} (P : B -> Type) (f : A -> B) (p : x = y) (z : P (f 
+x)),
+    transport (fun x => P (f x)) p z  =  transport P (ap f p) z.
+Delimit Scope morphism_scope with morphism.
+Delimit Scope category_scope with category.
+Delimit Scope object_scope with object.
+Record PreCategory := { object :> Type ; morphism : object -> object -> Type }.
+Delimit Scope functor_scope with functor.
+Record Functor (C D : PreCategory) :=
+  { object_of :> C -> D;
+    morphism_of : forall s d, morphism C s d -> morphism D (object_of s) 
+(object_of d) }.
+Arguments object_of {C%category D%category} f%functor c%object : rename, simpl 
+nomatch.
+Arguments morphism_of [C%category] [D%category] f%functor [s%object d%object] 
+m%morphism : rename, simpl nomatch.
+Section path_functor.
+  Variable C : PreCategory.
+  Variable D : PreCategory.
+
+  Local Notation path_functor'_T F G
+    := { HO : object_of F = object_of G
+       | transport (fun GO => forall s d, morphism C s d -> morphism D (GO s) 
+(GO d))
+                   HO
+                   (morphism_of F)
+         = morphism_of G }
+         (only parsing).
+  Definition path_functor'_sig_inv (F G : Functor C D) : F = G -> 
+path_functor'_T F G
+    := fun H'
+       => (ap object_of H';
+             (transport_compose _ object_of _ _) ^ @ apD (@morphism_of _ _) H').
+
+End path_functor.
+End A.
+
+(* A variant of it with more axioms *)
+
+Module B.
+Notation "{ x : A | P }" := (sigT (fun x:A => P)).
+Notation "( x ; y )" := (existT _ x y).
+Notation "p @ q" := (eq_trans p q) (at level 20).
+Notation "p ^" := (eq_sym p) (at level 3).
+Axiom transport : forall {A : Type} (P : A -> Type) {x y : A} (p : x = y) (u : P x), P y.
+Notation "p # x" := (transport _ p x) (right associativity, at level 65, only 
+parsing).
+Definition ap {A B:Type} (f:A -> B) {x y:A} (p:x = y) : f x = f y
+  := match p with eq_refl => eq_refl end.
+Axiom apD : forall {A:Type} {B:A->Type} (f:forall a:A, B a) {x y:A} (p:x=y), p # (f 
+x) = f y.
+Axiom transport_compose
+  : forall {A B} {x y : A} (P : B -> Type) (f : A -> B) (p : x = y) (z : P (f 
+x)),
+    transport (fun x => P (f x)) p z  =  transport P (ap f p) z.
+Record PreCategory := { object :> Type ; morphism : object -> object -> Type }.
+Record Functor (C D : PreCategory) :=
+  { object_of :> C -> D;
+    morphism_of : forall s d, morphism C s d -> morphism D (object_of s) 
+(object_of d) }.
+Arguments object_of {C D} f c : rename, simpl nomatch.
+Arguments morphism_of [C] [D] f [s d] m : rename, simpl nomatch.
+Section path_functor.
+  Variable C D : PreCategory.
+  Local Notation path_functor'_T F G
+    := { HO : object_of F = object_of G
+       | transport (fun GO => forall s d, morphism C s d -> morphism D (GO s) 
+(GO d))
+                   HO
+                   (morphism_of F)
+         = morphism_of G }.
+  Definition path_functor'_sig_inv (F G : Functor C D) : F = G -> 
+path_functor'_T F G
+    := fun H'
+       => (ap object_of H';
+             (transport_compose _ object_of _ _) ^ @ apD (@morphism_of _ _) H').
+
+End path_functor.
+End B.
diff --git a/test-suite/bugs/closed/4966.v b/test-suite/bugs/closed/4966.v
new file mode 100644
index 000000000..bd93cdc85
--- /dev/null
+++ b/test-suite/bugs/closed/4966.v
@@ -0,0 +1,10 @@
+(* Interpretation of auto as an argument of an ltac function (i.e. as an ident) was wrongly "auto with *" *)
+
+Axiom proof_admitted : False.
+Hint Extern 0 => case proof_admitted : unused.
+Ltac do_tac tac := tac.
+
+Goal False.
+  Set Ltac Profiling.
+  Fail solve [ do_tac auto ].
+Abort.
diff --git a/test-suite/bugs/closed/4970.v b/test-suite/bugs/closed/4970.v
new file mode 100644
index 000000000..7a896582f
--- /dev/null
+++ b/test-suite/bugs/closed/4970.v
@@ -0,0 +1,3 @@
+(* Check "{{" is not confused with "{" in notations *)
+Reserved Notation "x {{ y }}" (at level 40).
+Notation "x {{ y }}" := (x y) (only parsing).
diff --git a/test-suite/bugs/closed/5011.v b/test-suite/bugs/closed/5011.v
new file mode 100644
index 000000000..c3043ca5d
--- /dev/null
+++ b/test-suite/bugs/closed/5011.v
@@ -0,0 +1,2 @@
+Record decoder (n : nat) W := { decode : W -> nat }.
+Existing Class decoder.
diff --git a/test-suite/bugs/closed/5036.v b/test-suite/bugs/closed/5036.v
new file mode 100644
index 000000000..12c958be6
--- /dev/null
+++ b/test-suite/bugs/closed/5036.v
@@ -0,0 +1,10 @@
+Section foo.
+  Context (F : Type -> Type).
+  Context (admit : forall {T}, F T = True).
+  Hint Rewrite (fun T => @admit T).
+  Lemma bad : F False.
+  Proof.
+    autorewrite with core.
+    constructor.
+  Qed.
+End foo. (* Anomaly: Universe Top.16 undefined. Please report. *)
\ No newline at end of file
diff --git a/test-suite/bugs/closed/5043.v b/test-suite/bugs/closed/5043.v
new file mode 100644
index 000000000..4e6a0f878
--- /dev/null
+++ b/test-suite/bugs/closed/5043.v
@@ -0,0 +1,8 @@
+Unset Keep Admitted Variables.
+
+Section a.
+  Context (x : Type).
+  Definition foo : Type.
+  Admitted.
+End a.
+Check foo : Type.
diff --git a/test-suite/bugs/closed/5045.v b/test-suite/bugs/closed/5045.v
new file mode 100644
index 000000000..dc38738d8
--- /dev/null
+++ b/test-suite/bugs/closed/5045.v
@@ -0,0 +1,3 @@
+Axiom silly : 1 = 1 -> nat -> nat.
+Goal forall pf : 1 = 1, silly pf 0 = 0 -> True.
+  Fail generalize (@eq nat).
diff --git a/test-suite/bugs/closed/5065.v b/test-suite/bugs/closed/5065.v
new file mode 100644
index 000000000..6bd677ba6
--- /dev/null
+++ b/test-suite/bugs/closed/5065.v
@@ -0,0 +1,6 @@
+Inductive foo := C1 : bar -> foo with bar := C2 : foo -> bar.
+
+Lemma L1 : foo -> True with L2 : bar -> True.
+intros; clear L1 L2; abstract (exact I).
+intros; exact I.
+Qed.
\ No newline at end of file
diff --git a/test-suite/bugs/closed/5066.v b/test-suite/bugs/closed/5066.v
new file mode 100644
index 000000000..eed7f0f3f
--- /dev/null
+++ b/test-suite/bugs/closed/5066.v
@@ -0,0 +1,7 @@
+Require Import Vector.
+
+Fail Program Fixpoint vector_rev {A : Type} {n1 n2 : nat} (v1 : Vector.t A n1) (v2 : Vector.t A n2) : Vector.t A (n1+n2) :=
+  match v1 with
+  | nil _          => v2
+  | cons _ e n' sv => vector_rev sv (cons A e n2 v2)
+  end.
diff --git a/test-suite/bugs/closed/5077.v b/test-suite/bugs/closed/5077.v
new file mode 100644
index 000000000..7e7f2c373
--- /dev/null
+++ b/test-suite/bugs/closed/5077.v
@@ -0,0 +1,8 @@
+(* Testing robustness of typing for a fixpoint with evars in its type *)
+
+Inductive foo (n : nat) : Type := .
+Definition foo_denote {n} (x : foo n) : Type := match x with end.
+
+Definition baz : forall n (x : foo n), foo_denote x.
+refine (fix go n (x : foo n) : foo_denote x := _).
+Abort.  
diff --git a/test-suite/bugs/closed/5078.v b/test-suite/bugs/closed/5078.v
new file mode 100644
index 000000000..ca73cbcc1
--- /dev/null
+++ b/test-suite/bugs/closed/5078.v
@@ -0,0 +1,5 @@
+(* Test coercion from ident to evaluable reference *)
+Tactic Notation "unfold_hyp" hyp(H) := cbv delta [H].
+Goal True -> Type.
+  intro H''.
+  Fail unfold_hyp H''.
diff --git a/test-suite/bugs/closed/5093.v b/test-suite/bugs/closed/5093.v
new file mode 100644
index 000000000..3ded4dd30
--- /dev/null
+++ b/test-suite/bugs/closed/5093.v
@@ -0,0 +1,11 @@
+Axiom P : nat -> Prop.
+Axiom PS : forall n, P n -> P (S n).
+Axiom P0 : P 0.
+
+Hint Resolve PS : foobar.
+Hint Resolve P0 : foobar.
+
+Goal P 100.
+Proof.
+Fail typeclasses eauto 100 with foobar.
+typeclasses eauto 101 with foobar.
diff --git a/test-suite/bugs/closed/5095.v b/test-suite/bugs/closed/5095.v
new file mode 100644
index 000000000..b6f38e3e8
--- /dev/null
+++ b/test-suite/bugs/closed/5095.v
@@ -0,0 +1,5 @@
+(* Checking let-in abstraction *)
+Goal let x := Set in let y := x in True.
+  intros x y.
+  (* There used to have a too strict dependency test there *)
+  set (s := Set) in (value of x).
diff --git a/test-suite/bugs/closed/5096.v b/test-suite/bugs/closed/5096.v
new file mode 100644
index 000000000..20a537ab3
--- /dev/null
+++ b/test-suite/bugs/closed/5096.v
@@ -0,0 +1,219 @@
+Require Import Coq.FSets.FMapPositive Coq.PArith.BinPos Coq.Lists.List.
+
+Set Asymmetric Patterns.
+
+Notation eta x := (fst x, snd x).
+
+Inductive expr {var : Type} : Type :=
+| Const : expr
+| LetIn : expr -> (var -> expr) -> expr.
+
+Definition Expr := forall var, @expr var.
+
+Fixpoint count_binders (e : @expr unit) : nat :=
+match e with
+| LetIn _ eC => 1 + @count_binders (eC tt)
+| _ => 0
+end.
+
+Definition CountBinders (e : Expr) : nat := count_binders (e _).
+
+Class Context (Name : Type) (var : Type) :=
+  { ContextT : Type;
+    extendb : ContextT -> Name -> var -> ContextT;
+    empty : ContextT }.
+Coercion ContextT : Context >-> Sortclass.
+Arguments ContextT {_ _ _}, {_ _} _.
+Arguments extendb {_ _ _} _ _ _.
+Arguments empty {_ _ _}.
+
+Module Export Named.
+Inductive expr Name : Type :=
+| Const : expr Name
+| LetIn : Name -> expr Name -> expr Name -> expr Name.
+End Named.
+
+Global Arguments Const {_}.
+Global Arguments LetIn {_} _ _ _.
+
+Definition split_onames {Name : Type} (ls : list (option Name))
+  : option (Name) * list (option Name)
+  := match ls with
+          | cons n ls'
+            => (n, ls')
+          | nil => (None, nil)
+     end.
+
+Section internal.
+  Context (InName OutName : Type)
+          {InContext : Context InName (OutName)}
+          {ReverseContext : Context OutName (InName)}
+          (InName_beq : InName -> InName -> bool).
+
+  Fixpoint register_reassign (ctxi : InContext) (ctxr : ReverseContext)
+           (e : expr InName) (new_names : list (option OutName))
+    : option (expr OutName)
+    := match e in Named.expr _ return option (expr _) with
+       | Const => Some Const
+       | LetIn n ex eC
+         => let '(n', new_names') := eta (split_onames new_names) in
+            match n', @register_reassign ctxi ctxr ex nil with
+            | Some n', Some x
+              => let ctxi := @extendb _ _ _ ctxi n n' in
+                 let ctxr := @extendb _ _ _ ctxr n' n in
+                 option_map (LetIn n' x) (@register_reassign ctxi ctxr eC new_names')
+            | None, Some x
+              => let ctxi := ctxi in
+                 @register_reassign ctxi ctxr eC new_names'
+            | _, None => None
+            end
+       end.
+
+End internal.
+
+Global Instance pos_context (var : Type) : Context positive var
+  := { ContextT := PositiveMap.t var;
+       extendb ctx key v := PositiveMap.add key v ctx;
+       empty := PositiveMap.empty _ }.
+
+Global Arguments register_reassign {_ _ _ _} ctxi ctxr e _.
+
+Section language5.
+  Context (Name : Type).
+
+  Local Notation expr := (@Top.expr Name).
+  Local Notation nexpr := (@Named.expr Name).
+
+  Fixpoint ocompile (e : expr) (ls : list (option Name)) {struct e}
+    : option (nexpr)
+    := match e in @Top.expr _ return option (nexpr) with
+       | Top.Const => Some Named.Const
+       | Top.LetIn ex eC
+         => match @ocompile ex nil, split_onames ls with
+            | Some x, (Some n, ls')%core
+              => option_map (fun C => Named.LetIn n x C) (@ocompile (eC n) ls')
+            | _, _ => None
+            end
+       end.
+
+  Definition compile (e : expr) (ls : list Name) := @ocompile e (List.map (@Some _) ls).
+End language5.
+
+Global Arguments compile {_} e ls.
+
+Fixpoint merge_liveness (ls1 ls2 : list unit) :=
+  match ls1, ls2 with
+  | cons x xs, cons y ys => cons tt (@merge_liveness xs ys)
+  | nil, ls | ls, nil => ls
+  end.
+
+Section internal1.
+  Context (Name : Type)
+          (OutName : Type)
+          {Context : Context Name (list unit)}.
+
+  Definition compute_livenessf_step
+             (compute_livenessf : forall (ctx : Context) (e : expr Name) (prefix : list unit), list unit)
+             (ctx : Context)
+             (e : expr Name) (prefix : list unit)
+    : list unit
+    := match e with
+       | Const => prefix
+       | LetIn n ex eC
+         => let lx := @compute_livenessf ctx ex prefix in
+            let lx := merge_liveness lx (prefix ++ repeat tt 1) in
+            let ctx := @extendb _ _ _ ctx n (lx) in
+            @compute_livenessf ctx eC (prefix ++ repeat tt 1)
+       end.
+
+  Fixpoint compute_liveness ctx e prefix
+    := @compute_livenessf_step (@compute_liveness) ctx e prefix.
+
+  Fixpoint insert_dead_names_gen def (ls : list unit) (lsn : list OutName)
+    : list (option OutName)
+    := match ls with
+       | nil => nil
+       | cons live xs
+         => match lsn with
+            | cons n lsn' => Some n :: @insert_dead_names_gen def xs lsn'
+            | nil => def :: @insert_dead_names_gen def xs nil
+            end
+       end.
+  Definition insert_dead_names def (e : expr Name)
+    := insert_dead_names_gen def (compute_liveness empty e nil).
+End internal1.
+
+Global Arguments insert_dead_names {_ _ _} def e lsn.
+
+Definition Let_In {A P} (x : A) (f : forall a : A, P a) : P x := let y := x in f y.
+
+Section language7.
+  Context {Context : Context unit (positive)}.
+
+  Local Notation nexpr := (@Named.expr unit).
+
+  Definition CompileAndEliminateDeadCode (e : Expr) (ls : list unit)
+    : option (nexpr)
+    := let e := compile (Name:=positive) (e _) (List.map Pos.of_nat (seq 1 (CountBinders e))) in
+       match e with
+       | Some e => Let_In (insert_dead_names None e ls) (* help vm_compute by factoring this out *)
+                          (fun names => register_reassign empty empty e names)
+       | None => None
+       end.
+End language7.
+
+Global Arguments CompileAndEliminateDeadCode {_} e ls.
+
+Definition ContextOn {Name1 Name2} f {var} (Ctx : Context Name1 var) : Context Name2 var
+  := {| ContextT := Ctx;
+        extendb ctx n v := extendb ctx (f n) v;
+        empty := empty |}.
+
+Definition Register := Datatypes.unit.
+
+Global Instance RegisterContext {var : Type} : Context Register var
+  := ContextOn (fun _ => 1%positive) (pos_context var).
+
+Definition syntax := Named.expr Register.
+
+Definition AssembleSyntax e ls (res := CompileAndEliminateDeadCode e ls)
+  := match res return match res with None => _ | _ => _ end with
+     | Some v => v
+     | None => I
+     end.
+
+Definition dummy_registers (n : nat) : list Register
+  := List.map (fun _ => tt) (seq 0 n).
+Definition DefaultRegisters (e : Expr) : list Register
+  := dummy_registers (CountBinders e).
+
+Definition DefaultAssembleSyntax e := @AssembleSyntax e (DefaultRegisters e).
+
+Notation "'slet' x := A 'in' b" := (Top.LetIn A (fun x => b)) (at level 200, b at level 200).
+Notation "#[ var ]#" := (@Top.Const var).
+
+Definition compiled_syntax : Expr := fun (var : Type) =>
+(
+  slet x1 := #[ var ]# in
+  slet x1 := #[ var ]# in
+  slet x1 := #[ var ]# in
+  slet x1 := #[ var ]# in
+  slet x1 := #[ var ]# in
+  slet x1 := #[ var ]# in
+  slet x1 := #[ var ]# in
+  slet x1 := #[ var ]# in
+  slet x1 := #[ var ]# in
+  slet x1 := #[ var ]# in
+  slet x1 := #[ var ]# in
+  slet x1 := #[ var ]# in
+  slet x1 := #[ var ]# in
+  slet x1 := #[ var ]# in
+  slet x1 := #[ var ]# in
+  slet x1 := #[ var ]# in
+  slet x1 := #[ var ]# in
+ @Top.Const var).
+
+Definition v :=
+  Eval cbv [compiled_syntax] in (DefaultAssembleSyntax (compiled_syntax)).
+
+Timeout 2 Eval vm_compute in v.
diff --git a/test-suite/bugs/closed/5097.v b/test-suite/bugs/closed/5097.v
new file mode 100644
index 000000000..37b239cf6
--- /dev/null
+++ b/test-suite/bugs/closed/5097.v
@@ -0,0 +1,7 @@
+(* Tracing existing evars along the weakening rule ("clear") *)
+Goal forall y, exists x, x=0->x=y.
+intros.
+eexists ?[x].
+intros.
+let x:=constr:(ltac:(clear y; exact 0)) in idtac x.
+Abort.
diff --git a/test-suite/bugs/closed/5123.v b/test-suite/bugs/closed/5123.v
new file mode 100644
index 000000000..bcde510ee
--- /dev/null
+++ b/test-suite/bugs/closed/5123.v
@@ -0,0 +1,33 @@
+(* IN 8.5pl2 and 8.6 (4da2131), the following shows different typeclass resolution behaviors following an unshelve tactical vs. an Unshelve command: *)
+
+(*Pose an open constr to prevent immediate typeclass resolution in holes:*)
+Tactic Notation "opose" open_constr(x) "as" ident(H) := pose x as H.
+
+Inductive vect A : nat -> Type :=
+| vnil : vect A 0
+| vcons : forall (h:A) (n:nat), vect A n -> vect A (S n).
+
+Class Eqdec A := eqdec : forall a b : A, {a=b}+{a<>b}.
+
+Require Bool.
+
+Instance Bool_eqdec : Eqdec bool := Bool.bool_dec.
+
+Context `{vect_sigT_eqdec : forall A : Type, Eqdec A -> Eqdec {a : nat & vect A a}}.
+
+Typeclasses eauto := debug.
+
+Goal True.
+  unshelve opose (@vect_sigT_eqdec _ _ _ _) as H.
+  all:cycle 2.
+  eapply existT. (*BUG: Why does this do typeclass resolution in the evar?*)
+  Focus 5.
+Abort.
+
+Goal True.
+  opose (@vect_sigT_eqdec _ _ _ _) as H.
+  Unshelve.
+  all:cycle 3.
+  eapply existT. (*This does no typeclass resultion, which is correct.*)
+  Focus 5.
+Abort.
\ No newline at end of file
diff --git a/test-suite/bugs/closed/5127.v b/test-suite/bugs/closed/5127.v
new file mode 100644
index 000000000..831e8fb50
--- /dev/null
+++ b/test-suite/bugs/closed/5127.v
@@ -0,0 +1,15 @@
+Fixpoint arrow (n: nat) :=
+  match n with
+  | S n => bool -> arrow n
+  | O => bool
+  end.
+
+Fixpoint apply (n : nat) : arrow n -> bool :=
+  match n return arrow n -> bool with
+  | S n => fun f => apply _ (f true)
+  | O => fun x => x
+  end.
+
+Axiom f : arrow 10000.
+Definition v : bool := Eval compute in apply _ f.
+Definition w : bool := Eval vm_compute in v.
diff --git a/test-suite/bugs/closed/5145.v b/test-suite/bugs/closed/5145.v
new file mode 100644
index 000000000..0533d21e0
--- /dev/null
+++ b/test-suite/bugs/closed/5145.v
@@ -0,0 +1,10 @@
+Class instructions :=
+  {
+    W : Type;
+    ldi : nat -> W
+  }.
+
+Fail Definition foo :=
+  let y2 := ldi 0 in
+  let '(CF, _) := (true, 0) in
+  y2.
diff --git a/test-suite/bugs/closed/5149.v b/test-suite/bugs/closed/5149.v
new file mode 100644
index 000000000..684dba196
--- /dev/null
+++ b/test-suite/bugs/closed/5149.v
@@ -0,0 +1,47 @@
+Goal forall x x' : nat, x = x' -> S x = S x -> exists y, S y = S x.
+intros.
+eexists.
+rewrite <- H.
+eassumption.
+Qed.
+
+Goal forall (base_type_code : Type) (t : base_type_code) (flat_type : Type) 
+            (t' : flat_type) (exprf interp_flat_type0 interp_flat_type1 : 
+flat_type -> Type)
+            (v v' : interp_flat_type1 t'),
+    v = v' ->
+    forall (interpf : forall t0 : flat_type, exprf t0 -> interp_flat_type1 t0)
+           (SmartVarVar : forall t0 : flat_type, interp_flat_type1 t0 -> 
+interp_flat_type0 t0)
+           (Tbase : base_type_code -> flat_type) (x : exprf (Tbase t))
+           (x' : interp_flat_type1 (Tbase t)) (T : Type)
+           (flatten_binding_list : forall t0 : flat_type,
+               interp_flat_type0 t0 -> interp_flat_type1 t0 -> list T)
+           (P : T -> list T -> Prop) (prod : Type -> Type -> Type)
+           (s : forall x0 : base_type_code, prod (exprf (Tbase x0)) 
+(interp_flat_type1 (Tbase x0)) -> T)
+           (pair : forall A B : Type, A -> B -> prod A B),
+      P (s t (pair (exprf (Tbase t)) (interp_flat_type1 (Tbase t)) x x'))
+        (flatten_binding_list t' (SmartVarVar t' v') v) ->
+      (forall (t0 : base_type_code) (t'0 : flat_type) (v0 : interp_flat_type1 
+t'0)
+              (x0 : exprf (Tbase t0)) (x'0 : interp_flat_type1 (Tbase t0)),
+          P (s t0 (pair (exprf (Tbase t0)) (interp_flat_type1 (Tbase t0)) x0 
+x'0))
+            (flatten_binding_list t'0 (SmartVarVar t'0 v0) v0) -> interpf 
+(Tbase t0) x0 = x'0) ->
+      interpf (Tbase t) x = x'.
+Proof.
+  intros ?????????????????????? interpf_SmartVarVar.
+  solve [ unshelve (subst; eapply interpf_SmartVarVar; eassumption) ] || fail 
+"too early".
+  Undo.
+  (** Implicitely at the dot. The first fails because unshelve adds a goal, and solve hence fails. The second has an ambiant unification problem that is solved after solve *)
+  Fail solve [ unshelve (eapply interpf_SmartVarVar; subst; eassumption) ].
+  solve [eapply interpf_SmartVarVar; subst; eassumption].
+  Undo.
+  Unset Solve Unification Constraints.
+  (* User control of when constraints are solved *)
+  solve [ unshelve (eapply interpf_SmartVarVar; subst; eassumption); solve_constraints ].
+Qed.
+
diff --git a/test-suite/bugs/closed/5161.v b/test-suite/bugs/closed/5161.v
new file mode 100644
index 000000000..d28303b8a
--- /dev/null
+++ b/test-suite/bugs/closed/5161.v
@@ -0,0 +1,27 @@
+(* Check that the presence of binders with type annotation do not
+   prevent the recursive binder part to be found *)
+
+From Coq Require Import Utf8.
+
+Delimit Scope C_scope with C.
+Global Open Scope C_scope.
+
+Delimit Scope uPred_scope with I.
+
+Definition FORALL {T : Type} (f : T → Prop) : Prop := ∀ x, f x.
+
+Notation "∀ x .. y , P" :=
+  (FORALL (λ x, .. (FORALL (λ y, P)) ..)%I)
+  (at level 200, x binder, y binder, right associativity) : uPred_scope.
+Infix "∧" := and : uPred_scope.
+
+(* The next command fails with
+   In recursive notation with binders, Φ is expected to come without type.
+   I would expect this notation to work fine, since the ∀ does support
+   type annotation.
+*)
+Notation "'{{{' P } } } e {{{ x .. y ; pat , Q } } }" :=
+  (∀ Φ : _ → _,
+      (∀ x, .. (∀ y, Q ∧ Φ pat) .. ))%I
+    (at level 20, x closed binder, y closed binder,
+     format "{{{  P  } } }  e  {{{ x .. y ;  pat ,  Q } } }") : uPred_scope.
diff --git a/test-suite/bugs/closed/5180.v b/test-suite/bugs/closed/5180.v
new file mode 100644
index 000000000..261092ee6
--- /dev/null
+++ b/test-suite/bugs/closed/5180.v
@@ -0,0 +1,64 @@
+Universes a b c ω ω'.
+Definition Typeω := Type@{ω}.
+Definition Type2 : Typeω := Type@{c}.
+Definition Type1 : Type2 := Type@{b}.
+Definition Type0 : Type1 := Type@{a}.
+
+Set Universe Polymorphism.
+Set Printing Universes.
+
+Definition Typei' (n : nat)
+  := match n return Type@{ω'} with
+     | 0 => Type0
+     | 1 => Type1
+     | 2 => Type2
+     | _ => Typeω
+     end.
+Definition TypeOfTypei' {n} (x : Typei' n) : Type@{ω'}
+  := match n return Typei' n -> Type@{ω'} with
+     | 0 | 1 | 2 | _ => fun x => x
+     end x.
+Definition Typei (n : nat) : Typei' (S n)
+  := match n return Typei' (S n) with
+     | 0 => Type0
+     | 1 => Type1
+     | _ => Type2
+     end.
+Definition TypeOfTypei {n} (x : TypeOfTypei' (Typei n)) : Type@{ω'}
+  := match n return TypeOfTypei' (Typei n) -> Type@{ω'} with
+     | 0 | 1 | _ => fun x => x
+     end x.
+Check Typei 0 : Typei 1.
+Check Typei 1 : Typei 2.
+
+Definition lift' {n} : TypeOfTypei' (Typei n) -> TypeOfTypei' (Typei (S n))
+  := match n return TypeOfTypei' (Typei n) -> TypeOfTypei' (Typei (S n)) with
+     | 0 | 1 | 2 | _ => fun x => (x : Type)
+     end.
+Definition lift'' {n} : TypeOfTypei' (Typei n) -> TypeOfTypei' (Typei (S n))
+  := match n return TypeOfTypei' (Typei n) -> TypeOfTypei' (Typei (S n)) with
+     | 0 | 1 | 2 | _ => fun x => x
+     end. (* The command has indeed failed with message:
+In environment
+n : nat
+x : TypeOfTypei' (Typei 0)
+The term "x" has type "TypeOfTypei' (Typei 0)" while it is expected to have type
+ "TypeOfTypei' (Typei 1)" (universe inconsistency: Cannot enforce b = a because  a < b).
+ *)
+Check (fun x : TypeOfTypei' (Typei 0) => TypeOfTypei' (Typei 1)).
+
+Definition lift''' {n} : TypeOfTypei' (Typei n) -> TypeOfTypei' (Typei (S n)).
+  refine match n return TypeOfTypei' (Typei n) -> TypeOfTypei' (Typei (S n))  with
+         | 0 | 1 | 2 | _ => fun x => _
+         end.
+  exact x.
+  Undo.
+  (* The command has indeed failed with message:
+In environment
+n : nat
+x : TypeOfTypei' (Typei 0)
+The term "x" has type "TypeOfTypei' (Typei 0)" while it is expected to have type
+ "TypeOfTypei' (Typei 1)" (universe inconsistency: Cannot enforce b = a because  a < b).
+ *)
+  all:compute in *.
+  all:exact x.
\ No newline at end of file
diff --git a/test-suite/bugs/closed/5181.v b/test-suite/bugs/closed/5181.v
new file mode 100644
index 000000000..0e6d47197
--- /dev/null
+++ b/test-suite/bugs/closed/5181.v
@@ -0,0 +1,3 @@
+Definition foo (x y : nat) := x.
+Fail Arguments foo {_} : assert.
+
diff --git a/test-suite/bugs/closed/5188.v b/test-suite/bugs/closed/5188.v
new file mode 100644
index 000000000..e29ebfb4e
--- /dev/null
+++ b/test-suite/bugs/closed/5188.v
@@ -0,0 +1,5 @@
+Set Printing All.
+Axiom relation : forall (T : Type), Set.
+Axiom T : forall A (R : relation A), Set.
+Set Printing Universes.
+Parameter (A:_) (R:_) (e:@T A R).
diff --git a/test-suite/bugs/closed/5198.v b/test-suite/bugs/closed/5198.v
new file mode 100644
index 000000000..7254afb42
--- /dev/null
+++ b/test-suite/bugs/closed/5198.v
@@ -0,0 +1,39 @@
+(* -*- mode: coq; coq-prog-args: ("-emacs" "-boot" "-nois") -*- *)
+(* File reduced by coq-bug-finder from original input, then from 286 lines to 
+27 lines, then from 224 lines to 53 lines, then from 218 lines to 56 lines, 
+then from 269 lines to 180 lines, then from 132 lines to 48 lines, then from 
+253 lines to 65 lines, then from 79 lines to 65 lines *)
+(* coqc version 8.6.0 (November 2016) compiled on Nov 12 2016 14:43:52 with 
+OCaml 4.02.3
+   coqtop version jgross-Leopard-WS:/home/jgross/Downloads/coq/coq-v8.6,v8.6 
+(7e992fa784ee6fa48af8a2e461385c094985587d) *)
+Axiom admit : forall {T}, T.
+Set Printing Implicit.
+Inductive nat := O | S (_ : nat).
+Axiom f : forall (_ _ : nat), nat.
+Class ZLikeOps (e : nat)
+  := { LargeT : Type ; SmallT : Type ; CarryAdd : forall (_ _ : LargeT), LargeT 
+}.
+Class BarrettParameters :=
+  { b : nat ; k : nat ; ops : ZLikeOps (f b k) }.
+Axiom barrett_reduce_function_bundled : forall {params : BarrettParameters}
+                                               (_ : @LargeT _ (@ops params)),
+    @SmallT _ (@ops params).
+
+Global Instance ZZLikeOps e : ZLikeOps (f (S O) e)
+  := { LargeT := nat ; SmallT := nat ; CarryAdd x y := y }.
+Definition SRep := nat.
+Local Instance x86_25519_Barrett : BarrettParameters
+  := { b := S O ; k := O ; ops := ZZLikeOps O }.
+Definition SRepAdd : forall (_ _ : SRep), SRep
+  := let v := (fun x y => barrett_reduce_function_bundled (CarryAdd x y)) in
+     v.
+Definition SRepAdd' : forall (_ _ : SRep), SRep
+  := (fun x y => barrett_reduce_function_bundled (CarryAdd x y)).
+(* Error:
+In environment
+x : SRep
+y : SRep
+The term "x" has type "SRep" while it is expected to have type
+ "@LargeT ?e ?ZLikeOps".
+ *)
diff --git a/test-suite/bugs/closed/5203.v b/test-suite/bugs/closed/5203.v
new file mode 100644
index 000000000..ed137395f
--- /dev/null
+++ b/test-suite/bugs/closed/5203.v
@@ -0,0 +1,5 @@
+Goal True.
+  Typeclasses eauto := debug.
+  Fail solve [ typeclasses eauto ].
+  Fail typeclasses eauto.
+  
\ No newline at end of file
diff --git a/test-suite/bugs/closed/5208.v b/test-suite/bugs/closed/5208.v
new file mode 100644
index 000000000..b7a684a27
--- /dev/null
+++ b/test-suite/bugs/closed/5208.v
@@ -0,0 +1,222 @@
+Require Import Program.
+
+Require Import Coq.Strings.String.
+Require Import Coq.Strings.Ascii.
+Require Import Coq.Numbers.BinNums.
+
+Set Implicit Arguments.
+Set Strict Implicit.
+Set Universe Polymorphism.
+Set Printing Universes.
+
+Local Open Scope positive.
+
+Definition field : Type := positive.
+
+Section poly.
+  Universe U.
+
+  Inductive fields : Type :=
+  | pm_Leaf : fields
+  | pm_Branch : fields -> option Type@{U} -> fields -> fields.
+
+  Definition fields_left (f : fields) : fields :=
+    match f with
+    | pm_Leaf => pm_Leaf
+    | pm_Branch l _ _ => l
+    end.
+
+  Definition fields_right (f : fields) : fields :=
+    match f with
+    | pm_Leaf => pm_Leaf
+    | pm_Branch _ _ r => r
+    end.
+
+  Definition fields_here (f : fields) : option Type@{U} :=
+    match f with
+    | pm_Leaf => None
+    | pm_Branch _ s _ => s
+    end.
+
+  Fixpoint fields_get (p : field) (m : fields) {struct p} : option Type@{U} :=
+    match p with
+      | xH => match m with
+                | pm_Leaf => None
+                | pm_Branch _ x _ => x
+              end
+      | xO p' => fields_get p' match m with
+                               | pm_Leaf => pm_Leaf
+                               | pm_Branch L _ _ => L
+                             end
+      | xI p' => fields_get p' match m with
+                               | pm_Leaf => pm_Leaf
+                               | pm_Branch _ _ R => R
+                             end
+    end.
+
+  Definition fields_leaf : fields := pm_Leaf.
+
+  Inductive member (val : Type@{U}) : fields -> Type :=
+  | pmm_H : forall L R, member val (pm_Branch L (Some val) R)
+  | pmm_L : forall (V : option Type@{U}) L R, member val L -> member val (pm_Branch L V R)
+  | pmm_R : forall (V : option Type@{U}) L R, member val R -> member val (pm_Branch L V R).
+  Arguments pmm_H {_ _ _}.
+  Arguments pmm_L {_ _ _ _} _.
+  Arguments pmm_R {_ _ _ _} _.
+
+  Fixpoint get_member (val : Type@{U}) p {struct p}
+  : forall m, fields_get p m = @Some Type@{U} val -> member val m :=
+    match p as p return forall m, fields_get p m = @Some Type@{U} val -> member@{U} val m with
+      | xH => fun m =>
+        match m as m return fields_get xH m = @Some Type@{U} val -> member@{U} val m with
+        | pm_Leaf => fun pf : None = @Some Type@{U} _ =>
+                       match pf in _ = Z return match Z with
+                                                | Some _ => _
+                                                | None => unit
+                                                end
+                       with
+                       | eq_refl => tt
+                       end
+        | pm_Branch _ None _ => fun pf : None = @Some Type@{U} _ =>
+                                  match pf in _ = Z return match Z with
+                                                           | Some _ => _
+                                                           | None => unit
+                                                           end
+                                  with
+                                  | eq_refl => tt
+                                  end
+        | pm_Branch _ (Some x) _ => fun pf : @Some Type@{U} x = @Some Type@{U} val =>
+                                      match eq_sym pf in _ = Z return member@{U} val (pm_Branch _ Z _) with
+                                      | eq_refl => pmm_H
+                                      end
+        end
+      | xO p' => fun m =>
+        match m as m return fields_get (xO p') m = @Some Type@{U} val -> member@{U} val m with
+        | pm_Leaf => fun pf : fields_get p' pm_Leaf = @Some Type@{U} val =>
+                       @get_member _ p' pm_Leaf pf
+        | pm_Branch l _ _ => fun pf : fields_get p' l = @Some Type@{U} val =>
+                       @pmm_L _ _ _ _ (@get_member _ p' l pf)
+        end
+      | xI p' => fun m =>
+        match m as m return fields_get (xI p') m = @Some Type@{U} val -> member@{U} val m with
+        | pm_Leaf => fun pf : fields_get p' pm_Leaf = @Some Type@{U} val =>
+                       @get_member _ p' pm_Leaf pf
+        | pm_Branch l _ r => fun pf : fields_get p' r = @Some Type@{U} val =>
+                               @pmm_R _ _ _ _ (@get_member _ p' r pf)
+        end
+    end.
+
+  Inductive record : fields -> Type :=
+  | pr_Leaf : record pm_Leaf
+  | pr_Branch : forall L R (V : option Type@{U}),
+      record L ->
+      match V return Type@{U} with
+        | None => unit
+        | Some t => t
+      end ->
+      record R ->
+      record (pm_Branch L V R).
+
+
+  Definition record_left {L} {V : option Type@{U}} {R}
+             (r : record (pm_Branch L V R)) : record L :=
+    match r in record z
+          return match z with
+                 | pm_Branch L _ _ => record L
+                 | _ => unit
+                 end
+    with
+      | pr_Branch _ l _ _ => l
+      | pr_Leaf => tt
+    end.
+Set Printing All.
+  Definition record_at {L} {V : option Type@{U}} {R} (r : record (pm_Branch L V R))
+  : match V return Type@{U} with
+    | None => unit
+    | Some t => t
+    end :=
+    match r in record z
+          return match z (* return ?X *) with
+                 | pm_Branch _ V _ => match V return Type@{U} with
+                                     | None => unit
+                                     | Some t => t
+                                     end
+                 | _ => unit
+                 end
+    with
+      | pr_Branch _ _ v _ => v
+      | pr_Leaf => tt
+    end.
+
+  Definition record_here {L : fields} (v : Type@{U}) {R : fields}
+             (r : record (pm_Branch L (@Some Type@{U} v) R)) : v :=
+    match r in record z
+          return match z return Type@{U} with
+                 | pm_Branch _ (Some v) _ => v
+                 | _ => unit
+                 end
+    with
+      | pr_Branch _ _ v _ => v
+      | pr_Leaf => tt
+    end.
+
+  Definition record_right {L V R} (r : record (pm_Branch L V R)) : record R :=
+    match r in record z return match z with
+                                  | pm_Branch _ _ R => record R
+                                  | _ => unit
+                                end
+    with
+      | pr_Branch _ _ _ r => r
+      | pr_Leaf => tt
+    end.
+
+  Fixpoint record_get {val : Type@{U}} {pm : fields} (m : member val pm) : record pm -> val :=
+    match m in member _ pm return record pm -> val with
+      | pmm_H => fun r => record_here r
+      | pmm_L m' => fun r => record_get m' (record_left r)
+      | pmm_R m' => fun r => record_get m' (record_right r)
+    end.
+
+  Fixpoint record_set {val : Type@{U}} {pm : fields} (m : member val pm) (x : val) {struct m}
+  : record pm -> record pm :=
+    match m in member _ pm return record pm -> record pm with
+    | pmm_H => fun r =>
+      pr_Branch (Some _)
+                (record_left r)
+                x
+                (record_right r)
+    | pmm_L m' => fun r =>
+      pr_Branch _
+                (record_set m' x (record_left r))
+                (record_at r)
+                (record_right r)
+    | pmm_R m' => fun r =>
+      pr_Branch _ (record_left r)
+                (record_at r)
+                (record_set m' x (record_right r))
+    end.
+End poly.
+Axiom cheat : forall {A}, A.
+Lemma record_get_record_set_different:
+  forall (T: Type) (vars: fields)
+    (pmr pmw: member T vars)
+    (diff: pmr <> pmw)
+    (r: record vars) (val: T),
+    record_get pmr (record_set pmw val r) = record_get pmr r.
+Proof.
+  intros.
+  revert pmr diff r val.
+  induction pmw; simpl; intros.
+  - dependent destruction pmr.
+    + congruence.
+    + auto.
+    + auto.
+  - dependent destruction pmr.
+    + auto.
+    + simpl. apply IHpmw. congruence.
+    + auto.
+  - dependent destruction pmr.
+    + auto.
+    + auto.
+    + simpl. apply IHpmw. congruence.
+Qed.
diff --git a/test-suite/bugs/closed/5277.v b/test-suite/bugs/closed/5277.v
new file mode 100644
index 000000000..7abc38bfc
--- /dev/null
+++ b/test-suite/bugs/closed/5277.v
@@ -0,0 +1,11 @@
+(* Scheme Equality not robust wrt names *)
+
+Module A1.
+  Inductive A (T : Type) := C (a : T).
+  Scheme Equality for A. (* success *)
+End A1.
+
+Module A2.
+  Inductive A (x : Type) := C (a : x).
+  Scheme Equality for A. 
+End A2.
diff --git a/test-suite/bugs/closed/5322.v b/test-suite/bugs/closed/5322.v
new file mode 100644
index 000000000..01aec8f29
--- /dev/null
+++ b/test-suite/bugs/closed/5322.v
@@ -0,0 +1,14 @@
+(* Regression in computing types of branches in "match" *)
+Inductive flat_type := Unit | Prod (A B : flat_type).
+Inductive exprf (op : flat_type -> flat_type -> Type) {var : Type} : flat_type
+-> Type :=
+| Op {t1 tR} (opc : op t1 tR) (args : exprf op t1) : exprf op tR.
+Inductive op : flat_type -> flat_type -> Type := a : op Unit Unit.
+Arguments Op {_ _ _ _} _ _.
+Definition bound_op {var}
+           {src2 dst2}
+           (opc2 : op src2 dst2)
+  : forall (args2 : exprf op (var:=var) src2), Op opc2 args2 = Op opc2 args2.
+  refine match opc2 return (forall args2, Op opc2 args2 = Op opc2 args2) with
+         | _ => _
+         end.
diff --git a/test-suite/bugs/closed/5323.v b/test-suite/bugs/closed/5323.v
new file mode 100644
index 000000000..295b7cd9f
--- /dev/null
+++ b/test-suite/bugs/closed/5323.v
@@ -0,0 +1,26 @@
+(* Revealed a missing re-consideration of postponed problems *)
+
+Module A.
+Inductive flat_type := Unit | Prod (A B : flat_type).
+Inductive exprf (op : flat_type -> flat_type -> Type) {var : Type} : flat_type 
+-> Type :=
+| Op {t1 tR} (opc : op t1 tR) (args : exprf op t1) : exprf op tR.
+Inductive op : flat_type -> flat_type -> Type := .
+Arguments Op {_ _ _ _} _ _.
+Definition bound_op {var}
+           {src2 dst2}
+           (opc2 : op src2 dst2)
+  : forall (args2 : exprf op (var:=var) src2), Op opc2 args2 = Op opc2 args2
+  := match opc2 return (forall args2, Op opc2 args2 = Op opc2 args2) with end.
+End A.
+
+(* A shorter variant *)
+Module B.
+Inductive exprf (op : unit -> Type) : Type :=
+| A : exprf op
+| Op tR (opc : op tR) (args : exprf op) : exprf op.
+Inductive op : unit -> Type := .
+Definition bound_op (dst2 : unit) (opc2 : op dst2)
+  : forall (args2 : exprf op), Op op dst2 opc2 args2 = A op
+  := match opc2 in op h return (forall args2 : exprf ?[U], Op ?[V] ?[I] opc2 args2 = A op) with end.
+End B.
diff --git a/test-suite/bugs/closed/5331.v b/test-suite/bugs/closed/5331.v
new file mode 100644
index 000000000..28743736d
--- /dev/null
+++ b/test-suite/bugs/closed/5331.v
@@ -0,0 +1,11 @@
+(* Checking no anomaly on some unexpected intropattern *)
+
+Ltac ih H := induction H as H.
+Ltac ih' H H' := induction H as H'.
+
+Goal True -> True.
+Fail intro H; ih H.
+intro H; ih' H ipattern:([]).
+exact I.
+Qed.
+
diff --git a/test-suite/bugs/closed/HoTT_coq_020.v b/test-suite/bugs/closed/HoTT_coq_020.v
index 008fb72c4..73da464bb 100644
--- a/test-suite/bugs/closed/HoTT_coq_020.v
+++ b/test-suite/bugs/closed/HoTT_coq_020.v
@@ -22,8 +22,8 @@ Polymorphic Record NaturalTransformation objC C objD D (F G : Functor (objC := o
 
 Ltac present_obj from to :=
   match goal with
-           | [ _ : appcontext[from ?obj ?C] |- _ ] => progress change (from obj C) with (to obj C) in *
-           | [ |- appcontext[from ?obj ?C] ] => progress change (from obj C) with (to obj C) in *
+           | [ _ : context[from ?obj ?C] |- _ ] => progress change (from obj C) with (to obj C) in *
+           | [ |- context[from ?obj ?C] ] => progress change (from obj C) with (to obj C) in *
          end.
 
 Section NaturalTransformationComposition.
diff --git a/test-suite/bugs/closed/HoTT_coq_047.v b/test-suite/bugs/closed/HoTT_coq_047.v
index 29496be5e..bef3c33ca 100644
--- a/test-suite/bugs/closed/HoTT_coq_047.v
+++ b/test-suite/bugs/closed/HoTT_coq_047.v
@@ -1,3 +1,5 @@
+Unset Structural Injection.
+
 Inductive nCk : nat -> nat -> Type :=
   |zz : nCk 0 0
   | incl { m n : nat } : nCk m n -> nCk (S m) (S n)
diff --git a/test-suite/bugs/closed/HoTT_coq_058.v b/test-suite/bugs/closed/HoTT_coq_058.v
index 5e5d5ab3e..3d16e7ac0 100644
--- a/test-suite/bugs/closed/HoTT_coq_058.v
+++ b/test-suite/bugs/closed/HoTT_coq_058.v
@@ -95,10 +95,10 @@ Goal forall (T : Type) (T0 : T -> T -> Type)
                            | tt => idpath
                          end)) (x1; p) = (x1; p).
 intros.
-let F := match goal with |- appcontext[@transport _ (fun x0 => @?F x0) _ _ (@path_forall ?H ?X ?T ?f ?g ?e)] => constr:(F) end in
-let H := match goal with |- appcontext[@transport _ (fun x0 => @?F x0) _ _ (@path_forall ?H ?X ?T ?f ?g ?e)] => constr:(H) end in
-let X := match goal with |- appcontext[@transport _ (fun x0 => @?F x0) _ _ (@path_forall ?H ?X ?T ?f ?g ?e)] => constr:(X) end in
-let T := match goal with |- appcontext[@transport _ (fun x0 => @?F x0) _ _ (@path_forall ?H ?X ?T ?f ?g ?e)] => constr:(T) end in
+let F := match goal with |- context[@transport _ (fun x0 => @?F x0) _ _ (@path_forall ?H ?X ?T ?f ?g ?e)] => constr:(F) end in
+let H := match goal with |- context[@transport _ (fun x0 => @?F x0) _ _ (@path_forall ?H ?X ?T ?f ?g ?e)] => constr:(H) end in
+let X := match goal with |- context[@transport _ (fun x0 => @?F x0) _ _ (@path_forall ?H ?X ?T ?f ?g ?e)] => constr:(X) end in
+let T := match goal with |- context[@transport _ (fun x0 => @?F x0) _ _ (@path_forall ?H ?X ?T ?f ?g ?e)] => constr:(T) end in
 let t0 := fresh "t0" in
 let t1 := fresh "t1" in
 let T1 := lazymatch type of F with (?T -> _) -> _ => constr:(T) end in
@@ -116,7 +116,7 @@ let T1 := lazymatch type of F with (?T -> _) -> _ => constr:(T) end in
               let GL1' := fresh in
               set (GL0' := GL0);
 
-                let arg := match GL0 with appcontext[x0 ?arg] => constr:(arg) end in
+                let arg := match GL0 with context[x0 ?arg] => constr:(arg) end in
                 assert (t1 = arg) by (subst t1; reflexivity); subst t1;
                 pattern (x0 arg) in GL0';
                 match goal with
diff --git a/test-suite/bugs/closed/HoTT_coq_117.v b/test-suite/bugs/closed/HoTT_coq_117.v
index 5fbcfef4e..de60fd0ae 100644
--- a/test-suite/bugs/closed/HoTT_coq_117.v
+++ b/test-suite/bugs/closed/HoTT_coq_117.v
@@ -16,10 +16,29 @@ Definition path_forall `{Funext} {A : Type} {P : A -> Type} (f g : forall x : A,
 Admitted.
 
 Inductive Empty : Set := .
-Instance contr_from_Empty {_ : Funext} (A : Type) :
+Fail Instance contr_from_Empty {_ : Funext} (A : Type) :
+  Contr_internal (Empty -> A) :=
+  BuildContr _
+             (Empty_rect (fun _ => A))
+             (fun f => path_forall _ f (fun x => Empty_rect _ x)).
+
+Fail Instance contr_from_Empty {F : Funext} (A : Type) :
   Contr_internal (Empty -> A) :=
   BuildContr _
              (Empty_rect (fun _ => A))
              (fun f => path_forall _ f (fun x => Empty_rect _ x)).
+
+(** This could be disallowed, this uses the Funext argument *)
+Instance contr_from_Empty {_ : Funext} (A : Type) :
+  Contr_internal (Empty -> A) :=
+  BuildContr _
+             (Empty_rect (fun _ => A))
+             (fun f => path_forall _ f (fun x => Empty_rect (fun _ => _ x = f x) x)).
+
+Instance contr_from_Empty' {_ : Funext} (A : Type) :
+  Contr_internal (Empty -> A) :=
+  BuildContr _
+             (Empty_rect (fun _ => A))
+             (fun f => path_forall _ f (fun x => Empty_rect (fun _ => _ x = f x) x)).
 (* Toplevel input, characters 15-220:
 Anomaly: unknown meta ?190. Please report. *)
diff --git a/test-suite/bugs/closed/PLACEHOLDER.v b/test-suite/bugs/closed/PLACEHOLDER.v
new file mode 100644
index 000000000..e69de29bb
--- /dev/null
+++ b/test-suite/bugs/closed/PLACEHOLDER.v
diff --git a/test-suite/bugs/closed/bug_4836.v b/test-suite/bugs/closed/bug_4836.v
new file mode 100644
index 000000000..5838dcd8a
--- /dev/null
+++ b/test-suite/bugs/closed/bug_4836.v
@@ -0,0 +1 @@
+(* -*- coq-prog-args: ("-compile" "bugs/closed/PLACEHOLDER.v") -*- *)
diff --git a/test-suite/bugs/closed/bug_4836/PLACEHOLDER b/test-suite/bugs/closed/bug_4836/PLACEHOLDER
new file mode 100644
index 000000000..e69de29bb
--- /dev/null
+++ b/test-suite/bugs/closed/bug_4836/PLACEHOLDER
diff --git a/test-suite/bugs/opened/3383.v b/test-suite/bugs/opened/3383.v
deleted file mode 100644
index 9a14641a5..000000000
--- a/test-suite/bugs/opened/3383.v
+++ /dev/null
@@ -1,7 +0,0 @@
-Goal forall b : bool, match b as b' return if b' then True else True with true => I | false => I end = match b as b' return if b' then True else True with true => I | false => I end.
-intro.
-Fail lazymatch goal with
-| [ |- appcontext[match ?b as b' return @?P b' with true => ?t | false => ?f end] ]
-  => change (match b as b' return P b with true => t | false => f end) with (@bool_rect P t f)
-end. (* Toplevel input, characters 153-154:
-Error: The reference P was not found in the current environment. *)
diff --git a/test-suite/bugs/opened/4701.v b/test-suite/bugs/opened/4701.v
new file mode 100644
index 000000000..9286f0f1f
--- /dev/null
+++ b/test-suite/bugs/opened/4701.v
@@ -0,0 +1,23 @@
+(*Suppose we have*)
+
+  Inductive my_if {A B} : bool -> Type :=
+  | then_case (_ : A) : my_if true
+  | else_case (_ : B) : my_if false.
+  Notation "'If' b 'Then' A 'Else' B" := (@my_if A B b) (at level 10).
+
+(*then here are three inductive type declarations that work:*)
+
+  Inductive I1 :=
+  | i1 (x : I1).
+  Inductive I2 :=
+  | i2 (x : nat).
+  Inductive I3 :=
+  | i3 (b : bool) (x : If b Then I3 Else nat).
+
+(*and here is one that does not, despite being equivalent to [I3]:*)
+
+  Fail Inductive I4 :=
+  | i4 (b : bool) (x : if b then I4 else nat). (* Error: Non strictly positive occurrence of "I4" in
+   "forall b : bool, (if b then I4 else nat) -> I4". *)
+
+(*I think this one should work.  I believe this is a conservative extension over CIC: Since [match] statements returning types can always be re-encoded as inductive type families, the analysis should be independent of whether the constructor uses an inductive or a [match] statement.*)
diff --git a/test-suite/bugs/opened/4717.v b/test-suite/bugs/opened/4717.v
new file mode 100644
index 000000000..9ad474672
--- /dev/null
+++ b/test-suite/bugs/opened/4717.v
@@ -0,0 +1,19 @@
+(*See below. They sometimes work, and sometimes do not. Is this a bug?*)
+
+Require Import Omega Psatz.
+
+Definition foo := nat.
+
+Goal forall (n : foo), 0 = n - n.
+Proof. intros. omega. (* works *) Qed.
+
+Goal forall (x n : foo), x = x + n - n.
+Proof.
+  intros.
+  Fail omega. (* Omega can't solve this system *)
+  Fail lia. (* Cannot find witness. *)
+  unfold foo in *.
+  omega. (* works *)
+Qed.
+
+(* Guillaume Melquiond: What matters is the equality. In the first case, it is @eq nat. In the second case, it is @eq foo. The same issue exists for ring and field. So it is not a bug, but it is worth fixing.*)
diff --git a/test-suite/bugs/opened/4721.v b/test-suite/bugs/opened/4721.v
new file mode 100644
index 000000000..1f184b393
--- /dev/null
+++ b/test-suite/bugs/opened/4721.v
@@ -0,0 +1,13 @@
+Variables S1 S2 : Set.
+
+Goal @eq Type S1 S2 -> @eq Type S1 S2.
+intro H.
+Fail tauto.
+assumption.
+Qed.
+
+(*This is in 8.5pl1, and Matthieq Sozeau says: "That's a regression in tauto indeed, which now requires exact equality of the universes, through a non linear goal pattern matching:
+match goal with ?X1 |- ?X1 forces both instances of X1 to be convertible,
+with no additional universe constraints currently, but the two types are
+initially different. This can be fixed easily to allow the same flexibility
+as in 8.4 (or assumption) to unify the universes as well."*)
diff --git a/test-suite/bugs/opened/4728.v b/test-suite/bugs/opened/4728.v
new file mode 100644
index 000000000..230b4beb6
--- /dev/null
+++ b/test-suite/bugs/opened/4728.v
@@ -0,0 +1,72 @@
+(*I'd like the final [Check] in the following to work:*)
+
+Ltac fin_eta_expand :=
+  [ > lazymatch goal with
+      | [ H : _ |- _ ] => clear H
+      end..
+  | lazymatch goal with
+    | [ H : ?T |- ?T ]
+      => exact H
+    | [ |- ?G ]
+      => fail 0 "No hypothesis matching" G
+    end ];
+  let n := numgoals in
+  tryif constr_eq numgoals 0
+  then idtac
+  else fin_eta_expand.
+
+Ltac pre_eta_expand x :=
+  let T := type of x in
+  let G := match goal with |- ?G => G end in
+  unify T G;
+  unshelve econstructor;
+  destruct x;
+  fin_eta_expand.
+
+Ltac eta_expand x :=
+  let v := constr:(ltac:(pre_eta_expand x)) in
+  idtac v;
+  let v := (eval cbv beta iota zeta in v) in
+  exact v.
+
+Notation eta_expand x := (ltac:(eta_expand x)) (only parsing).
+
+Ltac partial_unify eqn :=
+  lazymatch eqn with
+  | ?x = ?x => idtac
+  | ?f ?x = ?g ?y
+    => partial_unify (f = g);
+       (tryif unify x y then
+           idtac
+         else tryif has_evar x then
+             unify x y
+           else tryif has_evar y then
+               unify x y
+             else
+               idtac)
+  | ?x = ?y
+    => idtac;
+       (tryif unify x y then
+           idtac
+         else tryif has_evar x then
+             unify x y
+           else tryif has_evar y then
+               unify x y
+             else
+               idtac)
+  end.
+
+Tactic Notation "{" open_constr(old_record) "with" open_constr(new_record) "}" :=
+  let old_record' := eta_expand old_record in
+  partial_unify (old_record = new_record);
+  eexact new_record.
+
+Set Implicit Arguments.
+Record prod A B := pair { fst : A ; snd : B }.
+Infix "*" := prod : type_scope.
+Notation "( x , y , .. , z )" := (pair .. (pair x y) .. z) : core_scope.
+
+Notation "{ old 'with' new }" := (ltac:({ old with new })) (only parsing).
+
+Check ltac:({ (1, 1) with {| snd := 2 |} }).
+Fail Check { (1, 1) with {| snd := 2 |} }. (* Error: Cannot infer this placeholder of type "Type"; should succeed *)
diff --git a/test-suite/bugs/opened/4755.v b/test-suite/bugs/opened/4755.v
new file mode 100644
index 000000000..9cc0d361e
--- /dev/null
+++ b/test-suite/bugs/opened/4755.v
@@ -0,0 +1,34 @@
+(*I'm not sure which behavior is better.  But if the change is intentional, it should be documented (I don't think it is), and it'd be nice if there were a flag for this, or if -compat 8.4 restored the old behavior.*)
+
+Require Import Coq.Setoids.Setoid Coq.Classes.Morphisms.
+Definition f (v : option nat) := match v with
+                                 | Some k => Some k
+                                 | None => None
+                                 end.
+
+Axioms F G : (option nat -> option nat) -> Prop.
+Axiom FG : forall f, f None = None -> F f = G f.
+
+Axiom admit : forall {T}, T.
+
+Existing Instance eq_Reflexive.
+
+Global Instance foo (A := nat)
+  : Proper ((pointwise_relation _ eq)
+              ==> eq ==> forall_relation (fun _ => Basics.flip Basics.impl))
+           (@option_rect A (fun _ => Prop)) | 0.
+exact admit.
+Qed.
+
+Global Instance bar (A := nat)
+  : Proper ((pointwise_relation _ eq)
+              ==> eq ==> eq ==> Basics.flip Basics.impl)
+           (@option_rect A (fun _ => Prop)) | 0.
+exact admit.
+Qed.
+
+Goal forall k, option_rect (fun _ => Prop) (fun v : nat => v = v /\ F f) True k.
+Proof.
+  intro.
+  pose proof (_ : (Proper (_ ==> eq ==> _) and)).
+  Fail setoid_rewrite (FG _ _); []. (* In 8.5: Error: Tactic failure: Incorrect number of goals (expected 2 tactics); works in 8.4 *)
diff --git a/test-suite/bugs/opened/4771.v b/test-suite/bugs/opened/4771.v
new file mode 100644
index 000000000..396d74bdb
--- /dev/null
+++ b/test-suite/bugs/opened/4771.v
@@ -0,0 +1,22 @@
+Module Type Foo.
+
+Parameter Inline t : nat.
+
+End Foo.
+
+Module F(X : Foo).
+
+Tactic Notation "foo" ref(x) := idtac.
+
+Ltac g := foo X.t.
+
+End F.
+
+Module N.
+Definition t := 0 + 0.
+End N.
+
+Module K := F(N).
+
+(* Was
+Anomaly: Uncaught exception Not_found. Please report. *)
diff --git a/test-suite/bugs/opened/4778.v b/test-suite/bugs/opened/4778.v
new file mode 100644
index 000000000..633d158e9
--- /dev/null
+++ b/test-suite/bugs/opened/4778.v
@@ -0,0 +1,35 @@
+Require Import Coq.Setoids.Setoid Coq.Classes.Morphisms.
+Definition f (v : option nat) := match v with
+                                 | Some k => Some k
+                                 | None => None
+                                 end.
+
+Axioms F G : (option nat -> option nat) -> Prop.
+Axiom FG : forall f, f None = None -> F f = G f.
+
+Axiom admit : forall {T}, T.
+
+Existing Instance eq_Reflexive.
+
+(* This instance is needed in 8.4, but is useless in 8.5 *)
+Global Instance foo (A := nat)
+  : Proper ((pointwise_relation _ eq)
+              ==> eq ==> forall_relation (fun _ => Basics.flip Basics.impl))
+           (@option_rect A (fun _ => Prop)) | 0.
+exact admit.
+Qed.
+
+(*
+(* This is required in 8.5, but useless in 8.4 *)
+Global Instance bar (A := nat)
+  : Proper ((pointwise_relation _ eq)
+              ==> eq ==> eq ==> Basics.flip Basics.impl)
+           (@option_rect A (fun _ => Prop)) | 0.
+exact admit.
+Qed.
+*)
+
+Goal forall k, option_rect (fun _ => Prop) (fun v : nat => v = v /\ F f) True k. Proof.
+  intro.
+  pose proof (_ : (Proper (_ ==> eq ==> _) and)).
+  Fail setoid_rewrite (FG _ _); [ | reflexivity.. ]. (* this should succeed without [Fail], as it does in 8.4 *)
diff --git a/test-suite/bugs/opened/4781.v b/test-suite/bugs/opened/4781.v
new file mode 100644
index 000000000..8b651ac22
--- /dev/null
+++ b/test-suite/bugs/opened/4781.v
@@ -0,0 +1,94 @@
+Ltac force_clear :=
+  clear;
+  repeat match goal with
+         | [ H : _ |- _ ] => clear H
+         | [ H := _ |- _ ] => clearbody H
+         end.
+
+Class abstract_term {T} (x : T) := by_abstract_term : T.
+Hint Extern 0 (@abstract_term ?T ?x) => force_clear; change T; abstract (exact x) : typeclass_instances.
+
+Goal True.
+(* These work: *)
+  let term := constr:(I) in
+  let T := type of term in
+  let x := constr:((_ : abstract_term term) : T) in
+  pose x.
+  let term := constr:(I) in
+  let T := type of term in
+  let x := constr:((_ : abstract_term term) : T) in
+  let x := (eval cbv iota in (let v : T := x in v)) in
+  pose x.
+  let term := constr:(I) in
+  let T := type of term in
+  let x := constr:((_ : abstract_term term) : T) in
+  let x := match constr:(Set) with ?y => constr:(y) end in
+  pose x.
+(* This fails with an error: *)
+  Fail let term := constr:(I) in
+  let T := type of term in
+  let x := constr:((_ : abstract_term term) : T) in
+  let x := match constr:(x) with ?y => constr:(y) end in
+  pose x. (* The command has indeed failed with message:
+Error: Variable y should be bound to a term. *)
+(* And the rest fail with Anomaly: Uncaught exception Not_found. Please report. *)
+  Fail let term := constr:(I) in
+  let T := type of term in
+  let x := constr:((_ : abstract_term term) : T) in
+  let x := match constr:(x) with ?y => y end in
+  pose x.
+  Fail let term := constr:(I) in
+  let T := type of term in
+  let x := constr:((_ : abstract_term term) : T) in
+  let x := (eval cbv iota in x) in
+  pose x.
+  Fail let term := constr:(I) in
+  let T := type of term in
+  let x := constr:((_ : abstract_term term) : T) in
+  let x := type of x in
+  pose x. (* should succeed *)
+  Fail let term := constr:(I) in
+  let T := type of term in
+  let x := constr:(_ : abstract_term term) in
+  let x := type of x in
+  pose x. (* should succeed *)
+
+(*Apparently what [cbv iota] doesn't see can't hurt it, and [pose] is perfectly happy with abstracted lemmas only some of the time.
+
+Even stranger, consider:*)
+  let term := constr:(I) in
+  let T := type of term in
+  let x := constr:((_ : abstract_term term) : T) in
+  let y := (eval cbv iota in (let v : T := x in v)) in
+  pose y;
+    let x' := fresh "x'" in
+    pose x as x'.
+      let x := (eval cbv delta [x'] in x') in
+      pose x;
+      let z := (eval cbv iota in x) in
+      pose z.
+
+(*This works fine.  But if I change the period to a semicolon, I get:*)
+
+      Fail let term := constr:(I) in
+  let T := type of term in
+  let x := constr:((_ : abstract_term term) : T) in
+  let y := (eval cbv iota in (let v : T := x in v)) in
+  pose y;
+    let x' := fresh "x'" in
+    pose x as x';
+      let x := (eval cbv delta [x'] in x') in
+      pose x. (* Anomaly: Uncaught exception Not_found. Please report. *)
+ (* should succeed *)
+(*and if I use the second one instead of [pose x] (note that using [idtac] works fine), I get:*)
+
+ Fail  let term := constr:(I) in
+  let T := type of term in
+  let x := constr:((_ : abstract_term term) : T) in
+  let y := (eval cbv iota in (let v : T := x in v)) in
+  pose y;
+    let x' := fresh "x'" in
+    pose x as x';
+      let x := (eval cbv delta [x'] in x') in
+      let z := (eval cbv iota in x) in (* Error: Variable x should be bound to a term. *)
+      idtac. (* should succeed *)
diff --git a/test-suite/bugs/opened/4803.v b/test-suite/bugs/opened/4803.v
new file mode 100644
index 000000000..4530548b8
--- /dev/null
+++ b/test-suite/bugs/opened/4803.v
@@ -0,0 +1,48 @@
+(* -*- coq-prog-args: ("-emacs" "-compat" "8.4") -*- *)
+(*Suppose a user wants to declare a new list-like notation with support for singletons in both 8.4 and 8.5.  If they use*)
+Require Import Coq.Lists.List.
+Require Import Coq.Vectors.Vector.
+Import ListNotations.
+Import VectorNotations.
+Set Implicit Arguments.
+Inductive mylist T := mynil | mycons (_ : T) (_ : mylist T).
+Arguments mynil {_}, _.
+
+Delimit Scope mylist_scope with mylist.
+Bind Scope mylist_scope with mylist.
+Delimit Scope vector_scope with vector.
+
+Notation " [ ] " := mynil (format "[ ]") : mylist_scope.
+Notation " [ x ] " := (mycons x mynil) : mylist_scope.
+Notation " [ x ; .. ; y ] " := (mycons x .. (mycons y mynil) ..) : mylist_scope.
+
+(** All of these should work fine in -compat 8.4 mode, just as they do in Coq 8.4.  There needs to be a way to specify notations above so that all of these [Check]s go through in both 8.4 and 8.5 *)
+Check [ ]%mylist : mylist _.
+Check [ ]%list : list _.
+Check []%vector : Vector.t _ _.
+Check [ _ ]%mylist : mylist _.
+Check [ _ ]%list : list _.
+Check [ _ ]%vector : Vector.t _ _.
+Check [ _ ; _ ]%list : list _.
+Check [ _ ; _ ]%vector : Vector.t _ _.
+Check [ _ ; _ ]%mylist : mylist _.
+Check [ _ ; _ ; _ ]%list : list _.
+Check [ _ ; _ ; _ ]%vector : Vector.t _ _.
+Check [ _ ; _ ; _ ]%mylist : mylist _.
+Check [ _ ; _ ; _ ; _ ]%list : list _.
+Check [ _ ; _ ; _ ; _ ]%vector : Vector.t _ _.
+Check [ _ ; _ ; _ ; _ ]%mylist : mylist _.
+
+(** Now check that we can add and then remove notations from the parser *)
+(* We should be able to stick some vernacular here to remove [] from the parser *)
+Fail Remove Notation "[]".
+Goal True.
+  (* This should not be a syntax error; before moving this file to closed, uncomment this line. *)
+  (* idtac; []. *)
+  constructor.
+Qed.
+
+Check { _ : _ & _ }.
+Reserved Infix "&" (at level 0).
+Fail Remove Infix "&".
+(* Check { _ : _ & _ }. *)
diff --git a/test-suite/bugs/opened/4813.v b/test-suite/bugs/opened/4813.v
new file mode 100644
index 000000000..b75170179
--- /dev/null
+++ b/test-suite/bugs/opened/4813.v
@@ -0,0 +1,5 @@
+(* An example one would like to see succeeding *)
+
+Record T := BT { t : Set }.
+Record U (x : T) := BU { u : t x -> Prop }.
+Fail Definition A (H : unit -> Prop) : U (BT unit) := BU _ H.
diff --git a/test-suite/csdp.cache b/test-suite/csdp.cache
deleted file mode 100644
index 297ac255d..000000000
--- a/test-suite/csdp.cache
+++ /dev/null
diff --git a/test-suite/interactive/proof_block.v b/test-suite/interactive/proof_block.v
new file mode 100644
index 000000000..31e349376
--- /dev/null
+++ b/test-suite/interactive/proof_block.v
@@ -0,0 +1,66 @@
+Goal False /\ True.
+Proof.
+split.
+  idtac.
+  idtac.
+  exact I.
+idtac.
+idtac.
+exact I.
+Qed.
+
+Lemma baz :  (exists n, n = 3 /\ n = 3) /\ True.
+Proof.
+split. { eexists. split. par: trivial. }
+trivial.
+Qed.
+
+Lemma baz1 :  (True /\ False) /\ True.
+Proof.
+split. { split. par: trivial. }
+trivial.
+Qed.
+
+Lemma foo : (exists n, n = 3 /\ n = 3) /\ True.
+Proof.
+split.
+  { idtac.
+    unshelve eexists.
+    { apply 3. }
+    { split.
+      { idtac. trivialx. }
+      { reflexivity. } } }
+  trivial.
+Qed.
+
+Lemma foo1 : False /\ True.
+Proof.
+split.
+  { exact I. }
+  { exact I. }
+Qed.
+
+Definition banana := true + 4. 
+
+Check banana.
+
+Lemma bar : (exists n, n = 3 /\ n = 3) /\ True.
+Proof.
+split.
+  - idtac.
+    unshelve eexists.
+    + apply 3.
+    + split.
+      * idtacx. trivial. 
+      * reflexivity.
+  - trivial.
+Qed.
+
+Lemma baz2 :  ((1=0 /\ False) /\ True) /\ False.
+Proof.
+split. split. split.
+ - solve [ auto ].
+ - solve [ trivial ].
+ - solve [ trivial ].
+ - exact 6.
+Qed.
\ No newline at end of file
diff --git a/test-suite/micromega/bertot.v b/test-suite/micromega/bertot.v
index bcf222f92..29171aed9 100644
--- a/test-suite/micromega/bertot.v
+++ b/test-suite/micromega/bertot.v
@@ -11,6 +11,8 @@ Require Import Psatz.
 
 Open Scope Z_scope.
 
+
+
 Goal (forall x y n,
   ( ~ x < n /\ x <= n /\ 2 * y = x*(x+1) -> 2 * y = n*(n+1))
   /\
diff --git a/test-suite/micromega/qexample.v b/test-suite/micromega/qexample.v
index 47e6005b9..d001e8f7f 100644
--- a/test-suite/micromega/qexample.v
+++ b/test-suite/micromega/qexample.v
@@ -6,32 +6,29 @@
 (*                                                                      *)
 (************************************************************************)
 
-Require Import Psatz.
+Require Import Lqa.
 Require Import QArith.
 
 Lemma plus_minus : forall x y,
   0 == x + y -> 0 ==  x -y -> 0 == x /\ 0 == y.
 Proof.
   intros.
-  psatzl Q.
+  lra.
 Qed.
 
-
-
-
 (* Other (simple) examples *)
 Open Scope Q_scope.
 
 Lemma binomial : forall x y:Q, ((x+y)^2 == x^2 + (2 # 1) *x*y + y^2).
 Proof.
   intros.
-  psatzl Q.
+  lra.
 Qed.
 
 
 Lemma hol_light19 : forall m n, (2 # 1) * m + n == (n + m) + m.
 Proof.
-  intros ; psatzl Q.
+  intros ; lra.
 Qed.
 Open Scope Z_scope.
 Open Scope Q_scope.
@@ -60,7 +57,11 @@ Lemma vcgen_25 : forall
   (( 1# 1) == (-2 # 1) * i + it).
 Proof.
   intros.
-  psatzl Q.
+  lra.
+Qed.
+
+Goal forall x : Q, x * x >= 0.
+  intro; nra. 
 Qed.
 
 Goal forall x, -x^2 >= 0 -> x - 1 >= 0 -> False.
diff --git a/test-suite/micromega/rexample.v b/test-suite/micromega/rexample.v
index 2eed7e951..bd5227010 100644
--- a/test-suite/micromega/rexample.v
+++ b/test-suite/micromega/rexample.v
@@ -6,16 +6,22 @@
 (*                                                                      *)
 (************************************************************************)
 
-Require Import Psatz.
+Require Import Lra.
 Require Import Reals.
 
 Open Scope R_scope.
 
+
+Lemma cst_test : 5^5 = 5 * 5 * 5 *5 *5.
+Proof.
+  lra.
+Qed.
+
 Lemma yplus_minus : forall x y,
   0 = x + y -> 0 =  x -y -> 0 = x /\ 0 = y.
 Proof.
   intros.
-  psatzl R.
+  lra.
 Qed.
 
 (* Other (simple) examples *)
@@ -23,13 +29,13 @@ Qed.
 Lemma binomial : forall x y, ((x+y)^2 = x^2 + 2 *x*y + y^2).
 Proof.
   intros.
-  psatzl R.
+  lra.
 Qed.
 
 
 Lemma hol_light19 : forall m n, 2 * m + n = (n + m) + m.
 Proof.
-  intros ; psatzl R.
+  intros ; lra.
 Qed.
 
 
@@ -57,7 +63,7 @@ Lemma vcgen_25 : forall
   (( 1 ) = (-2  ) * i + it).
 Proof.
   intros.
-  psatzl R.
+  lra.
 Qed.
 
 Goal forall x, -x^2 >= 0 -> x - 1 >= 0 -> False.
@@ -72,5 +78,11 @@ Proof.
 Qed.
 
 Lemma l1 : forall x y z : R, Rabs (x - z) <= Rabs (x - y) + Rabs (y - z).
-intros; split_Rabs; psatzl R.
-Qed.
\ No newline at end of file
+intros; split_Rabs; lra.
+Qed.
+
+(*  Bug 5073 *)
+Lemma opp_eq_0_iff a : -a = 0 <-> a = 0.
+Proof.
+  lra.
+Qed.
diff --git a/test-suite/micromega/zomicron.v b/test-suite/micromega/zomicron.v
index 0ec1dbfbc..239bc6936 100644
--- a/test-suite/micromega/zomicron.v
+++ b/test-suite/micromega/zomicron.v
@@ -8,9 +8,10 @@ Proof.
   lia.
 Qed.
 
+
 Lemma two_x_y_eq_1 : forall x y, 2 * x + 2 * y = 1 -> False.
 Proof.
-  intros.
+  intros. 
   lia.
 Qed.
 
@@ -20,6 +21,12 @@ Proof.
   lia.
 Qed.
 
+Lemma unused : forall x y, y >= 0 /\ x = 1 -> x = 1.
+Proof.
+  intros x y.
+  lia.
+Qed.
+
 Lemma omega_nightmare : forall x y, 27 <= 11 * x + 13 * y <= 45 ->  -10 <= 7 * x - 9 * y <= 4 -> False.
 Proof.
   intros ; intuition auto.
@@ -33,4 +40,53 @@ Lemma compact_proof : forall z,
 Proof.
  intros.
  lia.
-Qed.
\ No newline at end of file
+Qed.
+
+Lemma dummy_ex : exists (x:Z),  x = x.
+Proof.
+  eexists.
+  lia.
+  Unshelve.
+  exact Z0.
+Qed.
+
+Lemma unused_concl : forall x,
+    False -> x > 0 -> x < 0.
+Proof.
+  intro.
+  lia.
+Qed.
+
+Lemma unused_concl_match : forall (x:Z),
+    False -> match x with
+             | Z0 => True
+             | _ => x = x
+             end.
+Proof.
+  intros.
+  lia.
+Qed.
+
+Lemma fresh : forall (__arith : Prop),
+    __arith -> True.
+Proof.
+  intros.
+  lia.
+Qed.
+
+Class Foo {x : Z} := { T : Type ; dec : T -> Z }.
+Goal forall bound {F : @Foo bound} (x y : T), 0 <= dec x < bound -> 0 <= dec y 
+< bound -> dec x + dec y >= bound -> dec x + dec y < 2 * bound.
+Proof.
+  intros.
+  lia.
+Qed.
+
+(*  Bug 5073 *)
+Lemma opp_eq_0_iff a : -a = 0 <-> a = 0.
+Proof.
+  lia.
+Qed.
+
+
+
diff --git a/test-suite/misc/deps/A/A.v b/test-suite/misc/deps/A/A.v
new file mode 100644
index 000000000..49aaf4a79
--- /dev/null
+++ b/test-suite/misc/deps/A/A.v
@@ -0,0 +1 @@
+Definition b := true.
diff --git a/test-suite/misc/deps/B/A.v b/test-suite/misc/deps/B/A.v
new file mode 100644
index 000000000..c01a30dca
--- /dev/null
+++ b/test-suite/misc/deps/B/A.v
@@ -0,0 +1 @@
+Definition b := false.
diff --git a/test-suite/misc/deps/B/B.v b/test-suite/misc/deps/B/B.v
new file mode 100644
index 000000000..f3cda70a9
--- /dev/null
+++ b/test-suite/misc/deps/B/B.v
@@ -0,0 +1,7 @@
+Require A.
+
+Definition c := A.b.
+Lemma foo : c = false.
+Proof.
+reflexivity.
+Qed.
diff --git a/test-suite/misc/deps/checksum.v b/test-suite/misc/deps/checksum.v
new file mode 100644
index 000000000..450045e4b
--- /dev/null
+++ b/test-suite/misc/deps/checksum.v
@@ -0,0 +1,2 @@
+Require Import A.
+Fail Require Import B.
diff --git a/test-suite/output-modulo-time/ltacprof.out b/test-suite/output-modulo-time/ltacprof.out
new file mode 100644
index 000000000..cc04c2c9b
--- /dev/null
+++ b/test-suite/output-modulo-time/ltacprof.out
@@ -0,0 +1,12 @@
+total time:      1.528s
+
+ tactic                                   local  total   calls       max
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─sleep' -------------------------------- 100.0% 100.0%       1    1.528s
+─constructor ---------------------------   0.0%   0.0%       1    0.000s
+
+ tactic                                   local  total   calls       max
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─sleep' -------------------------------- 100.0% 100.0%       1    1.528s
+─constructor ---------------------------   0.0%   0.0%       1    0.000s
+
diff --git a/test-suite/output-modulo-time/ltacprof.v b/test-suite/output-modulo-time/ltacprof.v
new file mode 100644
index 000000000..6611db70e
--- /dev/null
+++ b/test-suite/output-modulo-time/ltacprof.v
@@ -0,0 +1,8 @@
+(* -*- coq-prog-args: ("-emacs" "-profile-ltac-cutoff" "0.0") -*- *)
+Ltac sleep' := do 100 (do 100 (do 100 idtac)).
+Ltac sleep := sleep'.
+
+Theorem x : True.
+Proof.
+  idtac. idtac. sleep. constructor.
+Defined.
diff --git a/test-suite/output-modulo-time/ltacprof_cutoff.out b/test-suite/output-modulo-time/ltacprof_cutoff.out
new file mode 100644
index 000000000..0cd5777cc
--- /dev/null
+++ b/test-suite/output-modulo-time/ltacprof_cutoff.out
@@ -0,0 +1,31 @@
+total time:      1.584s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─foo2 ----------------------------------   0.0% 100.0%       1    1.584s
+─sleep --------------------------------- 100.0% 100.0%       3    0.572s
+─foo1 ----------------------------------   0.0%  63.9%       1    1.012s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─foo2 ----------------------------------   0.0% 100.0%       1    1.584s
+└foo1 ----------------------------------   0.0%  63.9%       1    1.012s
+
+total time:      1.584s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─sleep --------------------------------- 100.0% 100.0%       3    0.572s
+─foo2 ----------------------------------   0.0% 100.0%       1    1.584s
+─foo1 ----------------------------------   0.0%  63.9%       1    1.012s
+─foo0 ----------------------------------   0.0%  31.3%       1    0.496s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─foo2 ----------------------------------   0.0% 100.0%       1    1.584s
+ ├─foo1 --------------------------------   0.0%  63.9%       1    1.012s
+ │ ├─sleep -----------------------------  32.6%  32.6%       1    0.516s
+ │ └─foo0 ------------------------------   0.0%  31.3%       1    0.496s
+ │  └sleep -----------------------------  31.3%  31.3%       1    0.496s
+ └─sleep -------------------------------  36.1%  36.1%       1    0.572s
+
diff --git a/test-suite/output-modulo-time/ltacprof_cutoff.v b/test-suite/output-modulo-time/ltacprof_cutoff.v
new file mode 100644
index 000000000..50131470e
--- /dev/null
+++ b/test-suite/output-modulo-time/ltacprof_cutoff.v
@@ -0,0 +1,12 @@
+(* -*- coq-prog-args: ("-emacs" "-profile-ltac") -*- *)
+Require Coq.ZArith.BinInt.
+Ltac sleep := do 50 (idtac; let sleep := (eval vm_compute in Coq.ZArith.BinInt.Z.div_eucl) in idtac).
+
+Ltac foo0 := idtac; sleep.
+Ltac foo1 := sleep; foo0.
+Ltac foo2 := sleep; foo1.
+Goal True.
+  foo2.
+  Show Ltac Profile CutOff 47.
+  constructor.
+Qed.
diff --git a/test-suite/output/Arguments.out b/test-suite/output/Arguments.out
index 2c7b04c62..a2ee2d4c8 100644
--- a/test-suite/output/Arguments.out
+++ b/test-suite/output/Arguments.out
@@ -101,4 +101,4 @@ Error: Unknown interpretation for notation "$".
 w 3 true = tt
      : Prop
 The command has indeed failed with message:
-Error: Extra argument _.
+Error: Extra arguments: _, _.
diff --git a/test-suite/output/Arguments.v b/test-suite/output/Arguments.v
index 05eeaac63..bd9240476 100644
--- a/test-suite/output/Arguments.v
+++ b/test-suite/output/Arguments.v
@@ -17,7 +17,7 @@ Definition fcomp A B C f (g : A -> B) (x : A) : C := f (g x).
 Arguments fcomp {_ _ _}%type_scope f g x /.
 About fcomp.
 Definition volatile := fun x : nat => x.
-Arguments volatile /.
+Arguments volatile / _.
 About volatile.
 Set Implicit Arguments.
 Section S1.
diff --git a/test-suite/output/ArgumentsScope.v b/test-suite/output/ArgumentsScope.v
index 1ff53294e..3a90cb79d 100644
--- a/test-suite/output/ArgumentsScope.v
+++ b/test-suite/output/ArgumentsScope.v
@@ -11,11 +11,11 @@ About b.
 About negb''.
 About negb'.
 About negb.
-Global Arguments Scope negb'' [ _ ].
-Global Arguments Scope negb' [ _ ].
-Global Arguments Scope negb [ _ ].
-Global Arguments Scope a [ _ ].
-Global Arguments Scope b [ _ ].
+Global Arguments negb'' _ : clear scopes.
+Global Arguments negb' _ : clear scopes.
+Global Arguments negb _ : clear scopes.
+Global Arguments a _ : clear scopes.
+Global Arguments b _ : clear scopes.
 About a.
 About b.
 About negb.
diff --git a/test-suite/output/Arguments_renaming.out b/test-suite/output/Arguments_renaming.out
index 1e3cc37df..b084ad498 100644
--- a/test-suite/output/Arguments_renaming.out
+++ b/test-suite/output/Arguments_renaming.out
@@ -1,13 +1,17 @@
 The command has indeed failed with message:
 Error: To rename arguments the "rename" flag must be specified.
 Argument A renamed to B.
-The command has indeed failed with message:
-Error: To rename arguments the "rename" flag must be specified.
-Argument A renamed to T.
+File "stdin", line 2, characters 0-25:
+Warning: This command is just asserting the names of arguments of identity.
+If this is what you want add ': assert' to silence the warning. If you want
+to clear implicit arguments add ': clear implicits'. If you want to clear
+notation scopes add ': clear scopes' [arguments-assert,vernacular]
 @eq_refl
      : forall (B : Type) (y : B), y = y
-@eq_refl nat
-     : forall x : nat, x = x
+eq_refl
+     : ?y = ?y
+where
+?y : [ |- nat] 
 Inductive eq (A : Type) (x : A) : A -> Prop :=  eq_refl : x = x
 
 For eq_refl: Arguments are renamed to B, y
@@ -99,15 +103,15 @@ Expands to: Constant Top.myplus
 @myplus
      : forall Z : Type, Z -> nat -> nat -> nat
 The command has indeed failed with message:
-Error: All arguments lists must declare the same names.
+Error: Argument lists should agree on the names they provide.
 The command has indeed failed with message:
-Error: The following arguments are not declared: x.
+Error: Sequences of implicit arguments must be of different lengths.
 The command has indeed failed with message:
-Error: Arguments names must be distinct.
+Error: Some argument names are duplicated: F
 The command has indeed failed with message:
 Error: Argument z cannot be declared implicit.
 The command has indeed failed with message:
-Error: Extra argument y.
+Error: Extra arguments: y.
 The command has indeed failed with message:
 Error: To rename arguments the "rename" flag must be specified.
 Argument A renamed to R.
diff --git a/test-suite/output/Arguments_renaming.v b/test-suite/output/Arguments_renaming.v
index e68fbd69f..0cb331347 100644
--- a/test-suite/output/Arguments_renaming.v
+++ b/test-suite/output/Arguments_renaming.v
@@ -1,6 +1,6 @@
 Fail Arguments eq_refl {B y}, [B] y.
-Fail Arguments identity T _ _.
-Arguments eq_refl A x.
+Arguments identity A _ _.
+Arguments eq_refl A x : assert.
 Arguments eq_refl {B y}, [B] y : rename.
 
 Check @eq_refl.
@@ -46,9 +46,9 @@ About myplus.
 Check @myplus.
 
 Fail Arguments eq_refl {F g}, [H] k.
-Fail Arguments eq_refl {F}, [F].
-Fail Arguments eq_refl {F F}, [F] F.
-Fail Arguments eq {F} x [z].
+Fail Arguments eq_refl {F}, [F] : rename.
+Fail Arguments eq_refl {F F}, [F] F : rename.
+Fail Arguments eq {F} x [z] : rename.
 Fail Arguments eq {F} x z y.
 Fail Arguments eq {R} s t.
 
diff --git a/test-suite/output/Binder.out b/test-suite/output/Binder.out
new file mode 100644
index 000000000..34558e9a6
--- /dev/null
+++ b/test-suite/output/Binder.out
@@ -0,0 +1,8 @@
+foo = fun '(x, y) => x + y
+     : nat * nat -> nat
+forall '(a, b), a /\ b
+     : Prop
+foo = λ '(x, y), x + y
+     : nat * nat → nat
+∀ '(a, b), a ∧ b
+     : Prop
diff --git a/test-suite/output/Binder.v b/test-suite/output/Binder.v
new file mode 100644
index 000000000..9aced9f66
--- /dev/null
+++ b/test-suite/output/Binder.v
@@ -0,0 +1,7 @@
+Definition foo '(x,y) := x + y.
+Print foo.
+Check forall '(a,b), a /\ b.
+
+Require Import Utf8.
+Print foo.
+Check forall '(a,b), a /\ b.
diff --git a/test-suite/output/Cases.out b/test-suite/output/Cases.out
index 2b828d382..8ce6f9795 100644
--- a/test-suite/output/Cases.out
+++ b/test-suite/output/Cases.out
@@ -56,3 +56,19 @@ match H with
      else fun _ : P false => Logic.I) x
 end
      : B -> True
+The command has indeed failed with message:
+Non exhaustive pattern-matching: no clause found for pattern 
+gadtTy _ _
+The command has indeed failed with message:
+In environment
+texpDenote : forall t : type, texp t -> typeDenote t
+t : type
+e : texp t
+t1 : type
+t2 : type
+t0 : type
+b : tbinop t1 t2 t0
+e1 : texp t1
+e2 : texp t2
+The term "0" has type "nat" while it is expected to have type
+ "typeDenote t0".
diff --git a/test-suite/output/Cases.v b/test-suite/output/Cases.v
index a4d19d693..407489642 100644
--- a/test-suite/output/Cases.v
+++ b/test-suite/output/Cases.v
@@ -66,8 +66,8 @@ Print foo'.
 (* Was bug #3293 (eta-expansion at "match" printing time was failing because
    of let-in's interpreted as being part of the expansion)  *)
 
-Variable b : bool.
-Variable P : bool -> Prop.
+Axiom b : bool.
+Axiom P : bool -> Prop.
 Inductive B : Prop := AC : P b -> B.
 Definition f : B -> True.
 
@@ -77,3 +77,32 @@ destruct b as [|] ; exact Logic.I.
 Defined.
 
 Print f.
+
+(* Was enhancement request #5142 (error message reported on the most
+   general return clause heuristic) *)
+
+Inductive gadt : Type -> Type :=
+| gadtNat : nat -> gadt nat
+| gadtTy : forall T, T -> gadt T.
+
+Fail Definition gadt_id T (x: gadt T) : gadt T :=
+  match x with
+  | gadtNat n => gadtNat n
+  end.
+
+(* A variant of #5142 (see Satrajit Roy's example on coq-club (Oct 17, 2016)) *)
+
+Inductive type:Set:=Nat.
+Inductive tbinop:type->type->type->Set:= TPlus : tbinop Nat Nat Nat.
+Inductive texp:type->Set:=
+ |TNConst:nat->texp Nat
+ |TBinop:forall t1 t2 t, tbinop t1 t2 t->texp t1->texp t2->texp t.
+Definition typeDenote(t:type):Set:= match t with Nat => nat end.
+
+(* We expect a failure on TBinop *)
+Fail Fixpoint texpDenote t (e:texp t):typeDenote t:=
+  match e with
+  | TNConst n => n
+  | TBinop t1 t2 _ b e1 e2 => O
+  end.
+
diff --git a/test-suite/output/Errors.out b/test-suite/output/Errors.out
index 6354ad469..06a6b2d15 100644
--- a/test-suite/output/Errors.out
+++ b/test-suite/output/Errors.out
@@ -5,3 +5,6 @@ Unable to unify "nat" with "True".
 The command has indeed failed with message:
 In nested Ltac calls to "f" and "apply x", last call failed.
 Unable to unify "nat" with "True".
+The command has indeed failed with message:
+Ltac call to "instantiate ( (ident) := (lglob) )" failed.
+Error: Instance is not well-typed in the environment of ?x.
diff --git a/test-suite/output/Errors.v b/test-suite/output/Errors.v
index 352c87385..424d24801 100644
--- a/test-suite/output/Errors.v
+++ b/test-suite/output/Errors.v
@@ -16,3 +16,12 @@ Goal True.
 Fail simpl; apply 0.
 Fail simpl; f 0.
 Abort.
+
+(* Test instantiate error messages *)
+
+Goal forall T1 (P1 : T1 -> Type), sigT P1 -> sigT P1.
+intros T1 P1 H1.
+eexists ?[x].
+destruct H1 as [x1 H1].
+Fail instantiate (x:=projT1 x1).
+Abort.
diff --git a/test-suite/output/Fixpoint.out b/test-suite/output/Fixpoint.out
index a13ae4624..6879cbc3c 100644
--- a/test-suite/output/Fixpoint.out
+++ b/test-suite/output/Fixpoint.out
@@ -10,3 +10,5 @@ let fix f (m : nat) : nat := match m with
                              end in f 0
      : nat
 Ltac f id1 id2 := fix id1 2 with (id2 (n:_) (H:odd n) {struct H} : n >= 1)
+     = cofix inf : Inf := {| projS := inf |}
+     : Inf
diff --git a/test-suite/output/Fixpoint.v b/test-suite/output/Fixpoint.v
index 8afa50ba5..fafb478ba 100644
--- a/test-suite/output/Fixpoint.v
+++ b/test-suite/output/Fixpoint.v
@@ -44,4 +44,7 @@ fix even_pos_odd_pos 2 with (odd_pos_even_pos n (H:odd n) {struct H} : n >= 1).
   omega.
 Qed.
 
-
+CoInductive Inf := S { projS : Inf }.
+Definition expand_Inf (x : Inf) := S (projS x).
+CoFixpoint inf := S inf.
+Eval compute in inf.
diff --git a/test-suite/output/FunExt.out b/test-suite/output/FunExt.out
new file mode 100644
index 000000000..c6786c72f
--- /dev/null
+++ b/test-suite/output/FunExt.out
@@ -0,0 +1,19 @@
+The command has indeed failed with message:
+Ltac call to "extensionality in (var)" failed.
+Tactic failure: Not an extensional equality.
+The command has indeed failed with message:
+Ltac call to "extensionality in (var)" failed.
+Tactic failure: Not an extensional equality.
+The command has indeed failed with message:
+Ltac call to "extensionality in (var)" failed.
+Tactic failure: Not an extensional equality.
+The command has indeed failed with message:
+Ltac call to "extensionality in (var)" failed.
+Tactic failure: Not an extensional equality.
+The command has indeed failed with message:
+Ltac call to "extensionality in (var)" failed.
+Tactic failure: Already an intensional equality.
+The command has indeed failed with message:
+In nested Ltac calls to "extensionality in (var)" and
+"clearbody (ne_var_list)", last call failed.
+Error: Hypothesis e depends on the body of H'
diff --git a/test-suite/output/FunExt.v b/test-suite/output/FunExt.v
new file mode 100644
index 000000000..7658ce718
--- /dev/null
+++ b/test-suite/output/FunExt.v
@@ -0,0 +1,168 @@
+Require Import FunctionalExtensionality.
+
+(* Basic example *)
+Goal (forall x y z, x+y+z = z+y+x) -> (fun x y z => z+y+x) = (fun x y z => x+y+z).
+intro H.
+extensionality in H.
+symmetry in H.
+assumption.
+Qed.
+
+(* Test rejection of non-equality *)
+Goal forall H:(forall A:Prop, A), H=H -> forall H'':True, H''=H''.
+intros H H' H''.
+Fail extensionality in H.
+clear H'.
+Fail extensionality in H.
+Fail extensionality in H''.
+Abort.
+
+(* Test success on dependent equality *)
+Goal forall (p : forall x, S x = x + 1), p = p -> S = fun x => x + 1.
+intros p H.
+extensionality in p.
+assumption.
+Qed.
+
+(* Test dependent functional extensionality *)
+Goal forall (P:nat->Type) (Q:forall a, P a -> Type) (f g:forall a (b:P a), Q a b),
+   (forall x y, f x y = g x y) -> f = g.
+intros * H.
+extensionality in H.
+assumption.
+Qed.
+
+(* Other tests, courtesy of Jason Gross *)
+
+Goal forall A B C (D : forall a : A, C a -> Type) (f g : forall a : A, B -> forall c : C a, D a c), (forall a b c, f a b c = g a b c) -> f = g.
+Proof.
+  intros A B C D f g H.
+  extensionality in H.
+  match type of H with f = g => idtac end.
+  exact H.
+Qed.
+
+Section test_section.
+  Context A B C (D : forall a : A, C a -> Type) (f g : forall a : A, B -> forall c : C a, D a c)
+          (H : forall a b c, f a b c = g a b c).
+  Goal f = g.
+  Proof.
+    extensionality in H.
+    match type of H with f = g => idtac end.
+    exact H.
+  Qed.
+End test_section.
+
+Section test2.
+  Context A B C (D : forall a : A, C a -> Type) (f g : forall a : A, B -> forall c : C a, D a c)
+          (H : forall b a c, f a b c = g a b c).
+  Goal (fun b a c => f a b c) = (fun b a c => g a b c).
+  Proof.
+    extensionality in H.
+    match type of H with (fun b a => f a b) = (fun b' a' => g a' b') => idtac end.
+    exact H.
+  Qed.
+End test2.
+
+Section test3.
+  Context A B C (D : forall a : A, C a -> Type) (f g : forall a : A, B -> forall c : C a, D a c)
+          (H : forall a c, (fun b => f a b c) = (fun b => g a b c)).
+  Goal (fun a c b => f a b c) = (fun a c b => g a b c).
+  Proof.
+    extensionality in H.
+    match type of H with (fun a c b => f a b c) = (fun a' c' b' => g a' b' c') => idtac end.
+    exact H.
+  Qed.
+End test3.
+
+Section test4.
+  Context A B C (D : forall a : A, C a -> Type) (f g : forall a : A, B -> forall c : C a, D a c -> Type)
+          (H : forall b, (forall a c d, f a b c d) = (forall a c d, g a b c d)).
+  Goal (fun b => forall a c d, f a b c d) = (fun b => forall a c d, g a b c d).
+  Proof.
+    extensionality in H.
+    exact H.
+  Qed.
+End test4.
+
+Section test5.
+  Goal nat -> True.
+  Proof.
+    intro n.
+    Fail extensionality in n.
+    constructor.
+  Qed.
+End test5.
+
+Section test6.
+  Goal let f := fun A (x : A) => x in let pf := fun A x => @eq_refl _ (f A x) in f = f.
+  Proof.
+    intros f pf.
+    extensionality in pf.
+    match type of pf with f = f => idtac end.
+    exact pf.
+  Qed.
+End test6.
+
+Section test7.
+  Context A B C (D : forall a : A, C a -> Type) (f g : forall a : A, B -> forall c : C a, D a c)
+          (H : forall a b c, True -> f a b c = g a b c).
+  Goal True.
+  Proof.
+    extensionality in H.
+    match type of H with (fun a b c (_ : True) => f a b c) = (fun a' b' c' (_ : True) => g a' b' c') => idtac end.
+    constructor.
+  Qed.
+End test7.
+
+Section test8.
+  Context A B C (D : forall a : A, C a -> Type) (f g : forall a : A, B -> forall c : C a, D a c)
+          (H : True -> forall a b c, f a b c = g a b c).
+  Goal True.
+  Proof.
+    extensionality in H.
+    match type of H with (fun (_ : True) => f) = (fun (_ : True) => g) => idtac end.
+    constructor.
+  Qed.
+End test8.
+
+Section test9.
+  Context A B C (D : forall a : A, C a -> Type) (f g : forall a : A, B -> forall c : C a, D a c)
+          (H : forall b a c, f a b c = g a b c).
+  Goal (fun b a c => f a b c) = (fun b a c => g a b c).
+  Proof.
+    pose H as H'.
+    extensionality in H.
+    extensionality in H'.
+    let T := type of H in let T' := type of H' in constr_eq T T'.
+    match type of H with (fun b a => f a b) = (fun b' a' => g a' b') => idtac end.
+    exact H'.
+  Qed.
+End test9.
+
+Section test10.
+  Context A B C (D : forall a : A, C a -> Type) (f g : forall a : A, B -> forall c : C a, D a c)
+          (H : f = g).
+  Goal True.
+  Proof.
+    Fail extensionality in H.
+    constructor.
+  Qed.
+End test10.
+
+Section test11.
+  Context A B C (D : forall a : A, C a -> Type) (f g : forall a : A, B -> forall c : C a, D a c)
+          (H : forall a b c, f a b c = f a b c).
+  Goal True.
+  Proof.
+    pose H as H'.
+    pose (eq_refl : H = H') as e.
+    extensionality in H.
+    Fail extensionality in H'.
+    clear e.
+    extensionality in H'.
+    let T := type of H in let T' := type of H' in constr_eq T T'.
+    lazymatch type of H with f = f => idtac end.
+    constructor.
+  Qed.
+End test11.
diff --git a/test-suite/output/Notations.v b/test-suite/output/Notations.v
index adba688e6..2ccca829d 100644
--- a/test-suite/output/Notations.v
+++ b/test-suite/output/Notations.v
@@ -133,8 +133,7 @@ Fail Notation "( x , y , .. , z )" := (pair x (pair y z)).
 Fail Notation "( x , y , .. , z )" := (pair x .. (pair y w) ..).
 
 (* Right-unbound variable *)
-(* Now allowed with an only parsing restriction *)
-Notation "( x , y , .. , z )" := (pair y .. (pair z 0) ..).
+Notation "( x , y , .. , z )" := (pair y .. (pair z 0) ..) (only parsing).
 
 (* Not the right kind of recursive pattern *)
 Fail Notation "( x , y , .. , z )" := (ex (fun z => .. (ex (fun y => x)) ..)).
diff --git a/test-suite/output/Notations2.out b/test-suite/output/Notations2.out
index 6ff1d3837..ad60aeccc 100644
--- a/test-suite/output/Notations2.out
+++ b/test-suite/output/Notations2.out
@@ -12,7 +12,7 @@ let '(a, _, _) := (2, 3, 4) in a
      : nat
 exists myx y : bool, myx = y
      : Prop
-fun (P : nat -> nat -> Prop) (x : nat) => exists x0, P x x0
+fun (P : nat -> nat -> Prop) (x : nat) => exists y, P x y
      : (nat -> nat -> Prop) -> nat -> Prop
 ∃ n p : nat, n + p = 0
      : Prop
@@ -54,3 +54,33 @@ end
      : ∀ x : nat, x <= 0 -> {x0 : nat | x <= x0}
 exist (Q x) y conj
      : {x0 : A | Q x x0}
+% i
+     : nat -> nat
+% j
+     : nat -> nat
+{1, 2}
+     : nat -> Prop
+a#
+     : Set
+a#
+     : Set
+a≡
+     : Set
+a≡
+     : Set
+.≡
+     : Set
+.≡
+     : Set
+.a#
+     : Set
+.a#
+     : Set
+.a≡
+     : Set
+.a≡
+     : Set
+.α
+     : Set
+.α
+     : Set
diff --git a/test-suite/output/Notations2.v b/test-suite/output/Notations2.v
index 4e0d135d7..ceb29d1b9 100644
--- a/test-suite/output/Notations2.v
+++ b/test-suite/output/Notations2.v
@@ -106,3 +106,42 @@ Check fun x (H:le x 0) => exist (le x) 0 H.
 
 Parameters (A : Set) (x y : A) (Q : A -> A -> Prop) (conj : Q x y).
 Check (exist (Q x) y conj).
+
+(* Check bug #4854 *)
+Notation "% i" := (fun i : nat => i) (at level 0, i ident).
+Check %i.
+Check %j.
+
+(* Check bug raised on coq-club on Sep 12, 2016 *)
+
+Notation "{ x , y , .. , v }" := (fun a => (or .. (or (a = x) (a = y)) .. (a = v))).
+Check ({1, 2}).
+
+(**********************************************************************)
+(* Check notations of the form ".a", ".a≡", "a≡"                      *)
+(* Only "a#", "a≡" and ".≡" were working properly for parsing. The    *)
+(* other ones were working only for printing.                         *)
+
+Notation "a#" := nat.
+Check nat.
+Check a#.
+
+Notation "a≡" := nat.
+Check nat.
+Check a≡.
+
+Notation ".≡" := nat.
+Check nat.
+Check .≡.
+
+Notation ".a#" := nat.
+Check nat.
+Check .a#.
+
+Notation ".a≡" := nat.
+Check nat.
+Check .a≡.
+
+Notation ".α" := nat.
+Check nat.
+Check .α.
diff --git a/test-suite/output/Notations3.out b/test-suite/output/Notations3.out
new file mode 100644
index 000000000..360f37967
--- /dev/null
+++ b/test-suite/output/Notations3.out
@@ -0,0 +1,100 @@
+[<0, 2 >]
+     : nat * nat * (nat * nat)
+[<0, 2 >]
+     : nat * nat * (nat * nat)
+(0, 2, (2, 2))
+     : nat * nat * (nat * nat)
+pair (pair O (S (S O))) (pair (S (S O)) O)
+     : prod (prod nat nat) (prod nat nat)
+<< 0, 2, 4 >>
+     : nat * nat * nat * (nat * (nat * nat))
+<< 0, 2, 4 >>
+     : nat * nat * nat * (nat * (nat * nat))
+(0, 2, 4, (2, (2, 0)))
+     : nat * nat * nat * (nat * (nat * nat))
+(0, 2, 4, (0, (2, 4)))
+     : nat * nat * nat * (nat * (nat * nat))
+pair (pair (pair O (S (S O))) (S (S (S (S O)))))
+  (pair (S (S (S (S O)))) (pair (S (S O)) O))
+     : prod (prod (prod nat nat) nat) (prod nat (prod nat nat))
+ETA x y : nat, Nat.add
+     : nat -> nat -> nat
+ETA x y : nat, Nat.add
+     : nat -> nat -> nat
+ETA x y : nat, Nat.add
+     : nat -> nat -> nat
+fun x y : nat => Nat.add x y
+     : forall (_ : nat) (_ : nat), nat
+ETA x y : nat, le_S
+     : forall x y : nat, x <= y -> x <= S y
+fun f : forall x : nat * (bool * unit), ?T => CURRY (x : nat) (y : bool), f
+     : (forall x : nat * (bool * unit), ?T) ->
+       forall (x : nat) (y : bool), ?T@{x:=(x, (y, tt))}
+where
+?T : [x : nat * (bool * unit) |- Type] 
+fun f : forall x : bool * (nat * unit), ?T =>
+CURRYINV (x : nat) (y : bool), f
+     : (forall x : bool * (nat * unit), ?T) ->
+       forall (x : nat) (y : bool), ?T@{x:=(y, (x, tt))}
+where
+?T : [x : bool * (nat * unit) |- Type] 
+fun f : forall x : unit * nat * bool, ?T => CURRYLEFT (x : nat) (y : bool), f
+     : (forall x : unit * nat * bool, ?T) ->
+       forall (x : nat) (y : bool), ?T@{x:=(tt, x, y)}
+where
+?T : [x : unit * nat * bool |- Type] 
+fun f : forall x : unit * bool * nat, ?T =>
+CURRYINVLEFT (x : nat) (y : bool), f
+     : (forall x : unit * bool * nat, ?T) ->
+       forall (x : nat) (y : bool), ?T@{x:=(tt, y, x)}
+where
+?T : [x : unit * bool * nat |- Type] 
+forall n : nat, {#n | 1 > n}
+     : Prop
+forall x : nat, {|x | x > 0|}
+     : Prop
+exists2 x : nat, x = 1 & x = 2
+     : Prop
+fun n : nat =>
+foo2 n (fun x y z : nat => (fun _ _ _ : nat => x + y + z = 0) z y x)
+     : nat -> Prop
+fun n : nat =>
+foo2 n (fun a b c : nat => (fun _ _ _ : nat => a + b + c = 0) c b a)
+     : nat -> Prop
+fun n : nat =>
+foo2 n (fun n0 y z : nat => (fun _ _ _ : nat => n0 + y + z = 0) z y n0)
+     : nat -> Prop
+fun n : nat =>
+foo2 n (fun x n0 z : nat => (fun _ _ _ : nat => x + n0 + z = 0) z n0 x)
+     : nat -> Prop
+fun n : nat =>
+foo2 n (fun x y n0 : nat => (fun _ _ _ : nat => x + y + n0 = 0) n0 y x)
+     : nat -> Prop
+fun n : nat => {|n, y | fun _ _ _ : nat => n + y = 0 |}_2
+     : nat -> Prop
+fun n : nat => {|n, y | fun _ _ _ : nat => n + y = 0 |}_2
+     : nat -> Prop
+fun n : nat => {|n, n0 | fun _ _ _ : nat => n + n0 = 0 |}_2
+     : nat -> Prop
+fun n : nat =>
+foo2 n (fun x y z : nat => (fun _ _ _ : nat => x + y + n = 0) z y x)
+     : nat -> Prop
+fun n : nat =>
+foo2 n (fun x y z : nat => (fun _ _ _ : nat => x + y + n = 0) z y x)
+     : nat -> Prop
+fun n : nat => {|n, fun _ : nat => 0 = 0 |}_3
+     : nat -> Prop
+fun n : nat => {|n, fun _ : nat => n = 0 |}_3
+     : nat -> Prop
+fun n : nat => foo3 n (fun x _ : nat => ETA z : nat, (fun _ : nat => x = 0))
+     : nat -> Prop
+fun n : nat => {|n, fun _ : nat => 0 = 0 |}_4
+     : nat -> Prop
+fun n : nat => {|n, fun _ : nat => n = 0 |}_4
+     : nat -> Prop
+fun n : nat => foo4 n (fun _ _ : nat => ETA z : nat, (fun _ : nat => z = 0))
+     : nat -> Prop
+fun n : nat => foo4 n (fun _ y : nat => ETA z : nat, (fun _ : nat => y = 0))
+     : nat -> Prop
+tele (t : Type) '(y, z) (x : t0) := tt
+     : forall t : Type, nat * nat -> t -> fpack
diff --git a/test-suite/output/Notations3.v b/test-suite/output/Notations3.v
new file mode 100644
index 000000000..4b8bfe312
--- /dev/null
+++ b/test-suite/output/Notations3.v
@@ -0,0 +1,141 @@
+(**********************************************************************)
+(* Check printing of notations with several instances of a recursive pattern *)
+(* Was wrong but I could not trigger a problem due to the collision between *)
+(* different instances of ".." *)
+
+Notation "[< x , y , .. , z >]" := (pair (.. (pair x y) ..) z,pair y ( .. (pair z x) ..)).
+Check [<0,2>].
+Check ((0,2),(2,0)).
+Check ((0,2),(2,2)).
+Unset Printing Notations.
+Check [<0,2>].
+Set Printing Notations.
+
+Notation "<< x , y , .. , z >>" := ((.. (x,y) .., z),(z, .. (y,x) ..)).
+Check <<0,2,4>>.
+Check (((0,2),4),(4,(2,0))).
+Check (((0,2),4),(2,(2,0))).
+Check (((0,2),4),(0,(2,4))).
+Unset Printing Notations.
+Check <<0,2,4>>.
+Set Printing Notations.
+
+(**********************************************************************)
+(* Check notations with recursive notations both in binders and terms *)
+
+Notation "'ETA' x .. y , f" :=
+  (fun x => .. (fun y => (.. (f x) ..) y ) ..)
+  (at level 200, x binder, y binder).
+Check ETA (x:nat) (y:nat), Nat.add.
+Check ETA (x y:nat), Nat.add.
+Check ETA x y, Nat.add.
+Unset Printing Notations.
+Check ETA (x:nat) (y:nat), Nat.add.
+Set Printing Notations.
+Check ETA x y, le_S.
+
+Notation "'CURRY' x .. y , f" := (fun x => .. (fun y => f (x, .. (y,tt) ..)) ..)
+  (at level 200, x binder, y binder).
+Check fun f => CURRY (x:nat) (y:bool), f.
+
+Notation "'CURRYINV' x .. y , f" := (fun x => .. (fun y => f (y, .. (x,tt) ..)) ..)
+  (at level 200, x binder, y binder).
+Check fun f => CURRYINV (x:nat) (y:bool), f.
+
+Notation "'CURRYLEFT' x .. y , f" := (fun x => .. (fun y => f (.. (tt,x) .., y)) ..)
+  (at level 200, x binder, y binder).
+Check fun f => CURRYLEFT (x:nat) (y:bool), f.
+
+Notation "'CURRYINVLEFT' x .. y , f" := (fun x => .. (fun y => f (.. (tt,y) .., x)) ..)
+  (at level 200, x binder, y binder).
+Check fun f => CURRYINVLEFT (x:nat) (y:bool), f.
+
+(**********************************************************************)
+(* Notations with variables bound both as a term and as a binder      *)
+(* This is #4592 *)
+
+Notation "{# x | P }" := (ex2 (fun y => x = y) (fun x => P)).
+Check forall n:nat, {# n | 1 > n}.
+
+Parameter foo : forall {T}(x : T)(P : T -> Prop), Prop.
+Notation "{| x | P |}" := (foo x (fun x => P)).
+Check forall x:nat, {| x | x > 0 |}.
+
+Check ex2 (fun x => x=1) (fun x0 => x0=2).
+
+(* Other tests about alpha-conversions: the following notation
+   contains all three kinds of bindings:
+
+   - x is bound in the lhs as a term and a binder: its name is forced
+     by its position as a term; it can bind variables in P
+   - y is bound in the lhs as a binder only: its name is given by its
+     name as a binder in the term to display; it can bind variables in P
+   - z is a binder local to the rhs; it cannot bind a variable in P
+*)
+
+Parameter foo2 : forall {T}(x : T)(P : T -> T -> T -> Prop), Prop.
+Notation "{| x , y | P |}_2" := (foo2 x (fun x y z => P z y x)).
+
+(* Not printable: z (resp c, n) occurs in P *)
+Check fun n => foo2 n (fun x y z => (fun _ _ _ => x+y+z=0) z y x).
+Check fun n => foo2 n (fun a b c => (fun _ _ _ => a+b+c=0) c b a).
+Check fun n => foo2 n (fun n y z => (fun _ _ _ => n+y+z=0) z y n).
+Check fun n => foo2 n (fun x n z => (fun _ _ _ => x+n+z=0) z n x).
+Check fun n => foo2 n (fun x y n => (fun _ _ _ => x+y+n=0) n y x).
+
+(* Printable *)
+Check fun n => foo2 n (fun x y z => (fun _ _ _ => x+y=0) z y x).
+Check fun n => foo2 n (fun n y z => (fun _ _ _ => n+y=0) z y n).
+Check fun n => foo2 n (fun x n z => (fun _ _ _ => x+n=0) z n x).
+
+(* Not printable: renaming x into n would bind the 2nd occurrence of n *)
+Check fun n => foo2 n (fun x y z => (fun _ _ _ => x+y+n=0) z y x).
+Check fun n => foo2 n (fun x y z => (fun _ _ _ => x+y+n=0) z y x).
+
+(* Other tests *)
+Parameter foo3 : forall {T}(x : T)(P : T -> T -> T -> Prop), Prop.
+Notation "{| x , P |}_3" := (foo3 x (fun x x x => P x)).
+
+(* Printable *)
+Check fun n : nat => foo3 n (fun x y z => (fun _ => 0=0) z).
+Check fun n => foo3 n (fun x y z => (fun _ => z=0) z).
+
+(* Not printable: renaming z in n would hide the renaming of x into n *)
+Check fun n => foo3 n (fun x y z => (fun _ => x=0) z).
+
+(* Other tests *)
+Parameter foo4 : forall {T}(x : T)(P : T -> T -> T -> Prop), Prop.
+Notation "{| x , P |}_4" := (foo4 x (fun x _ z => P z)).
+
+(* Printable *)
+Check fun n : nat => foo4 n (fun x y z => (fun _ => 0=0) z).
+Check fun n => foo4 n (fun x y z => (fun _ => x=0) z).
+
+(* Not printable: y, z not allowed to occur in P *)
+Check fun n => foo4 n (fun x y z => (fun _ => z=0) z).
+Check fun n => foo4 n (fun x y z => (fun _ => y=0) z).
+
+(**********************************************************************)
+(* Test printing of #4932                                             *)
+
+Inductive ftele : Type :=
+| fb {T:Type} : T -> ftele
+| fr {T} : (T -> ftele) -> ftele.
+
+Fixpoint args ftele : Type :=
+  match ftele with
+    | fb _ => unit
+    | fr f => sigT (fun t => args (f t))
+  end.
+
+Definition fpack := sigT args.
+Definition pack fp fa : fpack := existT _ fp fa.
+
+Notation "'tele' x .. z := b" :=
+  (fun x => .. (fun z =>
+     pack (fr (fun x => .. ( fr (fun z => fb b) ) .. ) )
+          (existT _ x .. (existT _ z tt) .. )
+                ) ..)
+  (at level 85, x binder, z binder).
+
+Check tele (t:Type) '((y,z):nat*nat) (x:t) := tt.
diff --git a/test-suite/output/PatternsInBinders.out b/test-suite/output/PatternsInBinders.out
new file mode 100644
index 000000000..c012a86b0
--- /dev/null
+++ b/test-suite/output/PatternsInBinders.out
@@ -0,0 +1,39 @@
+swap = fun '(x, y) => (y, x)
+     : A * B -> B * A
+fun '(x, y) => (y, x)
+     : A * B -> B * A
+forall '(x, y), swap (x, y) = (y, x)
+     : Prop
+proj_informative = fun '(exist _ x _) => x : A
+     : {x : A | P x} -> A
+foo = fun '(Bar n b tt p) => if b then n + p else n - p
+     : Foo -> nat
+baz = 
+fun '(Bar n1 _ tt p1) '(Bar _ _ tt _) => n1 + p1
+     : Foo -> Foo -> nat
+swap = 
+fun (A B : Type) '(x, y) => (y, x)
+     : forall A B : Type, A * B -> B * A
+
+Arguments A, B are implicit and maximally inserted
+Argument scopes are [type_scope type_scope _]
+fun (A B : Type) '(x, y) => swap (x, y) = (y, x)
+     : forall A B : Type, A * B -> Prop
+forall (A B : Type) '(x, y), swap (x, y) = (y, x)
+     : Prop
+exists '(x, y), swap (x, y) = (y, x)
+     : Prop
+exists '(x, y) '(z, w), swap (x, y) = (z, w)
+     : Prop
+λ '(x, y), (y, x)
+     : A * B → B * A
+∀ '(x, y), swap (x, y) = (y, x)
+     : Prop
+both_z = 
+fun pat : nat * nat =>
+let '(n, p) as pat0 := pat return (F pat0) in (Z n, Z p) : F (n, p)
+     : forall pat : nat * nat, F pat
+fun '(x, y) '(z, t) => swap (x, y) = (z, t)
+     : A * B -> B * A -> Prop
+forall '(x, y) '(z, t), swap (x, y) = (z, t)
+     : Prop
diff --git a/test-suite/output/PatternsInBinders.v b/test-suite/output/PatternsInBinders.v
new file mode 100644
index 000000000..6fa357a90
--- /dev/null
+++ b/test-suite/output/PatternsInBinders.v
@@ -0,0 +1,66 @@
+Require Coq.Unicode.Utf8.
+
+(** The purpose of this file is to test printing of the destructive
+    patterns used in binders ([fun] and [forall]). *)
+
+Parameters (A B : Type) (P:A->Prop).
+
+Definition swap '((x,y) : A*B) := (y,x).
+Print swap.
+
+Check fun '((x,y) : A*B) => (y,x).
+
+Check forall '(x,y), swap (x,y) = (y,x).
+
+Definition proj_informative '(exist _ x _ : { x:A | P x }) : A := x.
+Print proj_informative.
+
+Inductive Foo := Bar : nat -> bool -> unit -> nat -> Foo.
+Definition foo '(Bar n b tt p) :=
+  if b then n+p else n-p.
+Print foo.
+
+Definition baz '(Bar n1 b1 tt p1) '(Bar n2 b2 tt p2) := n1+p1.
+Print baz.
+
+Module WithParameters.
+
+Definition swap {A B} '((x,y) : A*B) := (y,x).
+Print swap.
+
+Check fun (A B:Type) '((x,y) : A*B) => swap (x,y) = (y,x).
+Check forall (A B:Type) '((x,y) : A*B), swap (x,y) = (y,x).
+
+Check exists '((x,y):A*A), swap (x,y) = (y,x).
+Check exists '((x,y):A*A) '(z,w), swap (x,y) = (z,w).
+
+End WithParameters.
+
+(** Some test involving unicode notations. *)
+Module WithUnicode.
+
+  Import Coq.Unicode.Utf8.
+
+  Check λ '((x,y) : A*B),  (y,x).
+  Check ∀ '(x,y), swap (x,y) = (y,x).
+
+End WithUnicode.
+
+(** * Suboptimal printing *)
+
+Module Suboptimal.
+
+(** This test shows an example which exposes the [let] introduced by
+    the pattern notation in binders. *)
+
+Inductive Fin (n:nat) := Z : Fin n.
+Definition F '(n,p) : Type := (Fin n * Fin p)%type.
+Definition both_z '(n,p) : F (n,p) := (Z _,Z _).
+Print both_z.
+
+(** Test factorization of binders *)
+
+Check fun '((x,y) : A*B) '(z,t) => swap (x,y) = (z,t).
+Check forall '(x,y) '((z,t) : B*A), swap (x,y) = (z,t).
+
+End Suboptimal.
diff --git a/test-suite/output/PrintInfos.out b/test-suite/output/PrintInfos.out
index 98420409e..1307a8f26 100644
--- a/test-suite/output/PrintInfos.out
+++ b/test-suite/output/PrintInfos.out
@@ -66,14 +66,6 @@ For le_S: Argument n is implicit and maximally inserted
 For le: Argument scopes are [nat_scope nat_scope]
 For le_n: Argument scope is [nat_scope]
 For le_S: Argument scopes are [nat_scope nat_scope _]
-Inductive le (n : nat) : nat -> Prop :=
-    le_n : n <= n | le_S : forall m : nat, n <= m -> n <= S m
-
-For le_S: Argument m is implicit
-For le_S: Argument n is implicit and maximally inserted
-For le: Argument scopes are [nat_scope nat_scope]
-For le_n: Argument scope is [nat_scope]
-For le_S: Argument scopes are [nat_scope nat_scope _]
 comparison : Set
 
 Expands to: Inductive Coq.Init.Datatypes.comparison
@@ -92,19 +84,6 @@ Expanded type for implicit arguments
 bar : forall x : nat, x = 0
 
 Argument x is implicit and maximally inserted
-bar : foo
-
-Expanded type for implicit arguments
-bar : forall x : nat, x = 0
-
-Argument x is implicit and maximally inserted
-Expands to: Constant Top.bar
-*** [ bar : foo ]
-
-Expanded type for implicit arguments
-bar : forall x : nat, x = 0
-
-Argument x is implicit and maximally inserted
 Module Coq.Init.Peano
 Notation existS2 := existT2
 Expands to: Notation Coq.Init.Specif.existS2
@@ -117,15 +96,6 @@ For eq_refl, when applied to 1 argument:
   Argument A is implicit and maximally inserted
 For eq: Argument scopes are [type_scope _ _]
 For eq_refl: Argument scopes are [type_scope _]
-Inductive eq (A : Type) (x : A) : A -> Prop :=  eq_refl : x = x
-
-For eq: Argument A is implicit and maximally inserted
-For eq_refl, when applied to no arguments:
-  Arguments A, x are implicit and maximally inserted
-For eq_refl, when applied to 1 argument:
-  Argument A is implicit and maximally inserted
-For eq: Argument scopes are [type_scope _ _]
-For eq_refl: Argument scopes are [type_scope _]
 n:nat
 
 Hypothesis of the goal context.
diff --git a/test-suite/output/PrintInfos.v b/test-suite/output/PrintInfos.v
index 3c623346b..08918981a 100644
--- a/test-suite/output/PrintInfos.v
+++ b/test-suite/output/PrintInfos.v
@@ -12,10 +12,7 @@ Print Implicit Nat.add.
 
 About plus_n_O.
 
-Implicit Arguments le_S [[n] m].
-Print le_S.
-
-Arguments le_S {n} [m] _. (* Test new syntax *)
+Arguments le_S {n} [m] _.
 Print le_S.
 
 About comparison.
@@ -23,21 +20,15 @@ Print comparison.
 
 Definition foo := forall x, x = 0.
 Parameter bar : foo.
-Implicit Arguments bar [x].
-About bar.
-Print bar.
 
-Arguments bar [x]. (* Test new syntax *)
+Arguments bar [x].
 About bar.
 Print bar.
 
 About Peano. (* Module *)
 About existS2. (* Notation *)
 
-Implicit Arguments eq_refl [[A] [x]] [[A]].
-Print eq_refl.
-
-Arguments eq_refl {A} {x}, {A} x. (* Test new syntax *)
+Arguments eq_refl {A} {x}, {A} x.
 Print eq_refl.
 
 
diff --git a/test-suite/output/PrintModule.out b/test-suite/output/PrintModule.out
index db464fd07..751d5fcc4 100644
--- a/test-suite/output/PrintModule.out
+++ b/test-suite/output/PrintModule.out
@@ -2,3 +2,4 @@ Module N : S with Definition T := nat := M
 
 Module N : S with Module T := K := M
 
+Module Type Func = Funsig (T0:Test) Sig Parameter x : T0.t. End
diff --git a/test-suite/output/PrintModule.v b/test-suite/output/PrintModule.v
index 999d9a986..5f30f7cda 100644
--- a/test-suite/output/PrintModule.v
+++ b/test-suite/output/PrintModule.v
@@ -32,3 +32,19 @@ Module N : S with Module T := K := M.
 Print Module N.
 
 End BAR.
+
+Module QUX.
+
+Module Type Test.
+  Parameter t : Type.
+End Test.
+
+Module Type Func (T:Test).
+  Parameter x : T.t.
+End Func.
+
+Module Shortest_path (T : Test).
+Print Func.
+End Shortest_path.
+
+End QUX.
diff --git a/test-suite/output/Search.out b/test-suite/output/Search.out
index c17b285bc..81fda176e 100644
--- a/test-suite/output/Search.out
+++ b/test-suite/output/Search.out
@@ -1,108 +1,108 @@
 le_n: forall n : nat, n <= n
+le_0_n: forall n : nat, 0 <= n
 le_S: forall n m : nat, n <= m -> n <= S m
+le_n_S: forall n m : nat, n <= m -> S n <= S m
+le_pred: forall n m : nat, n <= m -> Nat.pred n <= Nat.pred m
+le_S_n: forall n m : nat, S n <= S m -> n <= m
+min_l: forall n m : nat, n <= m -> Nat.min n m = n
+max_r: forall n m : nat, n <= m -> Nat.max n m = m
+min_r: forall n m : nat, m <= n -> Nat.min n m = m
+max_l: forall n m : nat, m <= n -> Nat.max n m = n
 le_ind:
   forall (n : nat) (P : nat -> Prop),
   P n ->
   (forall m : nat, n <= m -> P m -> P (S m)) ->
   forall n0 : nat, n <= n0 -> P n0
-le_pred: forall n m : nat, n <= m -> Nat.pred n <= Nat.pred m
-le_S_n: forall n m : nat, S n <= S m -> n <= m
-le_0_n: forall n : nat, 0 <= n
-le_n_S: forall n m : nat, n <= m -> S n <= S m
-max_l: forall n m : nat, m <= n -> Nat.max n m = n
-max_r: forall n m : nat, n <= m -> Nat.max n m = m
-min_l: forall n m : nat, n <= m -> Nat.min n m = n
-min_r: forall n m : nat, m <= n -> Nat.min n m = m
-true: bool
 false: bool
-bool_rect: forall P : bool -> Type, P true -> P false -> forall b : bool, P b
-bool_ind: forall P : bool -> Prop, P true -> P false -> forall b : bool, P b
-bool_rec: forall P : bool -> Set, P true -> P false -> forall b : bool, P b
-andb: bool -> bool -> bool
-orb: bool -> bool -> bool
-implb: bool -> bool -> bool
-xorb: bool -> bool -> bool
+true: bool
+is_true: bool -> Prop
 negb: bool -> bool
-andb_prop: forall a b : bool, (a && b)%bool = true -> a = true /\ b = true
-andb_true_intro:
-  forall b1 b2 : bool, b1 = true /\ b2 = true -> (b1 && b2)%bool = true
 eq_true: bool -> Prop
-eq_true_rect:
-  forall P : bool -> Type, P true -> forall b : bool, eq_true b -> P b
-eq_true_ind:
-  forall P : bool -> Prop, P true -> forall b : bool, eq_true b -> P b
+implb: bool -> bool -> bool
+orb: bool -> bool -> bool
+andb: bool -> bool -> bool
+xorb: bool -> bool -> bool
+Nat.even: nat -> bool
+Nat.odd: nat -> bool
+BoolSpec: Prop -> Prop -> bool -> Prop
+Nat.eqb: nat -> nat -> bool
+Nat.testbit: nat -> nat -> bool
+Nat.ltb: nat -> nat -> bool
+Nat.leb: nat -> nat -> bool
+Nat.bitwise: (bool -> bool -> bool) -> nat -> nat -> nat -> nat
+bool_ind: forall P : bool -> Prop, P true -> P false -> forall b : bool, P b
+bool_rec: forall P : bool -> Set, P true -> P false -> forall b : bool, P b
 eq_true_rec:
   forall P : bool -> Set, P true -> forall b : bool, eq_true b -> P b
-is_true: bool -> Prop
-eq_true_ind_r:
-  forall (P : bool -> Prop) (b : bool), P b -> eq_true b -> P true
-eq_true_rec_r:
-  forall (P : bool -> Set) (b : bool), P b -> eq_true b -> P true
+eq_true_ind:
+  forall P : bool -> Prop, P true -> forall b : bool, eq_true b -> P b
 eq_true_rect_r:
   forall (P : bool -> Type) (b : bool), P b -> eq_true b -> P true
-BoolSpec: Prop -> Prop -> bool -> Prop
+eq_true_rec_r:
+  forall (P : bool -> Set) (b : bool), P b -> eq_true b -> P true
+eq_true_rect:
+  forall P : bool -> Type, P true -> forall b : bool, eq_true b -> P b
+bool_rect: forall P : bool -> Type, P true -> P false -> forall b : bool, P b
+eq_true_ind_r:
+  forall (P : bool -> Prop) (b : bool), P b -> eq_true b -> P true
+andb_true_intro:
+  forall b1 b2 : bool, b1 = true /\ b2 = true -> (b1 && b2)%bool = true
+andb_prop: forall a b : bool, (a && b)%bool = true -> a = true /\ b = true
 BoolSpec_ind:
   forall (P Q : Prop) (P0 : bool -> Prop),
   (P -> P0 true) ->
   (Q -> P0 false) -> forall b : bool, BoolSpec P Q b -> P0 b
-Nat.eqb: nat -> nat -> bool
-Nat.leb: nat -> nat -> bool
-Nat.ltb: nat -> nat -> bool
-Nat.even: nat -> bool
-Nat.odd: nat -> bool
-Nat.testbit: nat -> nat -> bool
-Nat.bitwise: (bool -> bool -> bool) -> nat -> nat -> nat -> nat
 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}
-eq_S: forall x y : nat, x = y -> S x = S y
-f_equal_nat: forall (B : Type) (f : nat -> B) (x y : nat), x = y -> f x = f y
-f_equal_pred: forall x y : nat, x = y -> Nat.pred x = Nat.pred y
+mult_n_O: forall n : nat, 0 = n * 0
+plus_O_n: forall n : nat, 0 + n = n
+plus_n_O: forall n : nat, n = n + 0
+n_Sn: forall n : nat, n <> S n
 pred_Sn: forall n : nat, n = Nat.pred (S n)
+O_S: forall n : nat, 0 <> S n
+f_equal_pred: forall x y : nat, x = y -> Nat.pred x = Nat.pred y
+eq_S: forall x y : nat, x = y -> S x = S y
 eq_add_S: forall n m : nat, S n = S m -> n = m
+min_r: forall n m : nat, m <= n -> Nat.min n m = m
+min_l: forall n m : nat, n <= m -> Nat.min n m = n
+max_r: forall n m : nat, n <= m -> Nat.max n m = m
+max_l: forall n m : nat, m <= n -> Nat.max n m = n
+plus_Sn_m: forall n m : nat, S n + m = S (n + m)
+plus_n_Sm: forall n m : nat, S (n + m) = n + S m
+f_equal_nat: forall (B : Type) (f : nat -> B) (x y : nat), x = y -> f x = f y
 not_eq_S: forall n m : nat, n <> m -> S n <> S m
-O_S: forall n : nat, 0 <> S n
-n_Sn: forall n : nat, n <> S n
+mult_n_Sm: forall n m : nat, n * m + n = n * S m
 f_equal2_plus:
   forall x1 y1 x2 y2 : nat, x1 = y1 -> x2 = y2 -> x1 + x2 = y1 + y2
+f_equal2_mult:
+  forall x1 y1 x2 y2 : nat, x1 = y1 -> x2 = y2 -> x1 * x2 = y1 * y2
 f_equal2_nat:
   forall (B : Type) (f : nat -> nat -> B) (x1 y1 x2 y2 : nat),
   x1 = y1 -> x2 = y2 -> f x1 x2 = f y1 y2
-plus_n_O: forall n : nat, n = n + 0
-plus_O_n: forall n : nat, 0 + n = n
-plus_n_Sm: forall n m : nat, S (n + m) = n + S m
-plus_Sn_m: forall n m : nat, S n + m = S (n + m)
-f_equal2_mult:
-  forall x1 y1 x2 y2 : nat, x1 = y1 -> x2 = y2 -> x1 * x2 = y1 * y2
-mult_n_O: forall n : nat, 0 = n * 0
-mult_n_Sm: forall n m : nat, n * m + n = n * S m
-max_l: forall n m : nat, m <= n -> Nat.max n m = n
-max_r: forall n m : nat, n <= m -> Nat.max n m = m
-min_l: forall n m : nat, n <= m -> Nat.min n m = n
-min_r: forall n m : nat, m <= n -> Nat.min n m = m
-andb_prop: forall a b : bool, (a && b)%bool = true -> a = true /\ b = true
 andb_true_intro:
   forall b1 b2 : bool, b1 = true /\ b2 = true -> (b1 && b2)%bool = true
+andb_prop: forall a b : bool, (a && b)%bool = true -> a = true /\ b = true
 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}
-andb_prop: forall a b : bool, (a && b)%bool = true -> a = true /\ b = true
 andb_true_intro:
   forall b1 b2 : bool, b1 = true /\ b2 = true -> (b1 && b2)%bool = true
 andb_prop: forall a b : bool, (a && b)%bool = true -> a = true /\ b = true
-h': newdef n <> n
+andb_prop: forall a b : bool, (a && b)%bool = true -> a = true /\ b = true
 h: n <> newdef n
 h': newdef n <> n
 h: n <> newdef n
+h': newdef n <> n
 h: n <> newdef n
 h: n <> newdef n
-h': ~ P n
 h: P n
 h': ~ P n
 h: P n
 h': ~ P n
 h: P n
+h': ~ P n
 h: P n
 h: P n
diff --git a/test-suite/output/SearchHead.out b/test-suite/output/SearchHead.out
index 0d5924ec6..7038eac22 100644
--- a/test-suite/output/SearchHead.out
+++ b/test-suite/output/SearchHead.out
@@ -1,39 +1,39 @@
 le_n: forall n : nat, n <= n
+le_0_n: forall n : nat, 0 <= n
 le_S: forall n m : nat, n <= m -> n <= S m
 le_pred: forall n m : nat, n <= m -> Nat.pred n <= Nat.pred m
-le_S_n: forall n m : nat, S n <= S m -> n <= m
-le_0_n: forall n : nat, 0 <= n
 le_n_S: forall n m : nat, n <= m -> S n <= S m
-true: bool
+le_S_n: forall n m : nat, S n <= S m -> n <= m
 false: bool
-andb: bool -> bool -> bool
-orb: bool -> bool -> bool
+true: bool
+negb: bool -> bool
 implb: bool -> bool -> bool
+orb: bool -> bool -> bool
+andb: bool -> bool -> bool
 xorb: bool -> bool -> bool
-negb: bool -> bool
-Nat.eqb: nat -> nat -> bool
-Nat.leb: nat -> nat -> bool
-Nat.ltb: nat -> nat -> bool
 Nat.even: nat -> bool
 Nat.odd: nat -> bool
+Nat.leb: nat -> nat -> bool
+Nat.ltb: nat -> nat -> bool
 Nat.testbit: nat -> nat -> bool
-eq_S: forall x y : nat, x = y -> S x = S y
-f_equal_pred: forall x y : nat, x = y -> Nat.pred x = Nat.pred y
+Nat.eqb: nat -> nat -> bool
+mult_n_O: forall n : nat, 0 = n * 0
+plus_O_n: forall n : nat, 0 + n = n
+plus_n_O: forall n : nat, n = n + 0
 pred_Sn: forall n : nat, n = Nat.pred (S n)
+f_equal_pred: forall x y : nat, x = y -> Nat.pred x = Nat.pred y
 eq_add_S: forall n m : nat, S n = S m -> n = m
-f_equal2_plus:
-  forall x1 y1 x2 y2 : nat, x1 = y1 -> x2 = y2 -> x1 + x2 = y1 + y2
-plus_n_O: forall n : nat, n = n + 0
-plus_O_n: forall n : nat, 0 + n = n
+eq_S: forall x y : nat, x = y -> S x = S y
+max_r: forall n m : nat, n <= m -> Nat.max n m = m
+max_l: forall n m : nat, m <= n -> Nat.max n m = n
+min_r: forall n m : nat, m <= n -> Nat.min n m = m
+min_l: forall n m : nat, n <= m -> Nat.min n m = n
 plus_n_Sm: forall n m : nat, S (n + m) = n + S m
 plus_Sn_m: forall n m : nat, S n + m = S (n + m)
+mult_n_Sm: forall n m : nat, n * m + n = n * S m
+f_equal2_plus:
+  forall x1 y1 x2 y2 : nat, x1 = y1 -> x2 = y2 -> x1 + x2 = y1 + y2
 f_equal2_mult:
   forall x1 y1 x2 y2 : nat, x1 = y1 -> x2 = y2 -> x1 * x2 = y1 * y2
-mult_n_O: forall n : nat, 0 = n * 0
-mult_n_Sm: forall n m : nat, n * m + n = n * S m
-max_l: forall n m : nat, m <= n -> Nat.max n m = n
-max_r: forall n m : nat, n <= m -> Nat.max n m = m
-min_l: forall n m : nat, n <= m -> Nat.min n m = n
-min_r: forall n m : nat, m <= n -> Nat.min n m = m
 h: newdef n
 h: P n
diff --git a/test-suite/output/SearchPattern.out b/test-suite/output/SearchPattern.out
index 1eb7eca8f..45ff5e73b 100644
--- a/test-suite/output/SearchPattern.out
+++ b/test-suite/output/SearchPattern.out
@@ -1,80 +1,78 @@
-true: bool
 false: bool
-andb: bool -> bool -> bool
-orb: bool -> bool -> bool
+true: bool
+negb: bool -> bool
 implb: bool -> bool -> bool
+orb: bool -> bool -> bool
+andb: bool -> bool -> bool
 xorb: bool -> bool -> bool
-negb: bool -> bool
-Nat.eqb: nat -> nat -> bool
-Nat.leb: nat -> nat -> bool
-Nat.ltb: nat -> nat -> bool
 Nat.even: nat -> bool
 Nat.odd: nat -> bool
+Nat.leb: nat -> nat -> bool
+Nat.ltb: nat -> nat -> bool
 Nat.testbit: nat -> nat -> bool
-O: nat
-S: nat -> nat
-length: forall A : Type, list A -> nat
+Nat.eqb: nat -> nat -> bool
+Nat.two: nat
 Nat.zero: nat
 Nat.one: nat
-Nat.two: nat
-Nat.succ: nat -> nat
+O: nat
+Nat.double: nat -> nat
+Nat.sqrt: nat -> nat
+Nat.div2: nat -> nat
+Nat.log2: nat -> nat
 Nat.pred: nat -> nat
+Nat.square: nat -> nat
+S: nat -> nat
+Nat.succ: nat -> nat
+Nat.ldiff: nat -> nat -> nat
 Nat.add: nat -> nat -> nat
-Nat.double: nat -> nat
+Nat.lor: nat -> nat -> nat
+Nat.lxor: nat -> nat -> nat
+Nat.land: nat -> nat -> nat
 Nat.mul: nat -> nat -> nat
 Nat.sub: nat -> nat -> nat
 Nat.max: nat -> nat -> nat
-Nat.min: nat -> nat -> nat
-Nat.pow: nat -> nat -> nat
 Nat.div: nat -> nat -> nat
+Nat.pow: nat -> nat -> nat
+Nat.min: nat -> nat -> nat
 Nat.modulo: nat -> nat -> nat
 Nat.gcd: nat -> nat -> nat
-Nat.square: nat -> nat
 Nat.sqrt_iter: nat -> nat -> nat -> nat -> nat
-Nat.sqrt: nat -> nat
 Nat.log2_iter: nat -> nat -> nat -> nat -> nat
-Nat.log2: nat -> nat
-Nat.div2: nat -> nat
+length: forall A : Type, list A -> nat
 Nat.bitwise: (bool -> bool -> bool) -> nat -> nat -> nat -> nat
-Nat.land: nat -> nat -> nat
-Nat.lor: nat -> nat -> nat
+Nat.div2: nat -> nat
+Nat.sqrt: nat -> nat
+Nat.log2: nat -> nat
+Nat.double: nat -> nat
+Nat.pred: nat -> nat
+Nat.square: nat -> nat
+Nat.succ: nat -> nat
+S: nat -> nat
 Nat.ldiff: nat -> nat -> nat
+Nat.pow: nat -> nat -> nat
+Nat.land: nat -> nat -> nat
 Nat.lxor: nat -> nat -> nat
-
-S: nat -> nat
-Nat.succ: nat -> nat
-Nat.pred: nat -> nat
-Nat.add: nat -> nat -> nat
-Nat.double: nat -> nat
+Nat.div: nat -> nat -> nat
 Nat.mul: nat -> nat -> nat
-Nat.sub: nat -> nat -> nat
-Nat.max: nat -> nat -> nat
 Nat.min: nat -> nat -> nat
-Nat.pow: nat -> nat -> nat
-Nat.div: nat -> nat -> nat
 Nat.modulo: nat -> nat -> nat
+Nat.sub: nat -> nat -> nat
+Nat.lor: nat -> nat -> nat
 Nat.gcd: nat -> nat -> nat
-Nat.square: nat -> nat
-Nat.sqrt_iter: nat -> nat -> nat -> nat -> nat
-Nat.sqrt: nat -> nat
+Nat.max: nat -> nat -> nat
+Nat.add: nat -> nat -> nat
 Nat.log2_iter: nat -> nat -> nat -> nat -> nat
-Nat.log2: nat -> nat
-Nat.div2: nat -> nat
+Nat.sqrt_iter: nat -> nat -> nat -> nat -> nat
 Nat.bitwise: (bool -> bool -> bool) -> nat -> nat -> nat -> nat
-Nat.land: nat -> nat -> nat
-Nat.lor: nat -> nat -> nat
-Nat.ldiff: nat -> nat -> nat
-Nat.lxor: nat -> nat -> nat
 mult_n_Sm: forall n m : nat, n * m + n = n * S m
-identity_refl: forall (A : Type) (a : A), identity a a
 iff_refl: forall A : Prop, A <-> A
+le_n: forall n : nat, n <= n
+identity_refl: forall (A : Type) (a : A), identity a a
 eq_refl: forall (A : Type) (x : A), x = x
 Nat.divmod: nat -> nat -> nat -> nat -> nat * nat
-le_n: forall n : nat, n <= n
-pair: forall A B : Type, A -> B -> A * B
 conj: forall A B : Prop, A -> B -> A /\ B
+pair: forall A B : Type, A -> B -> A * B
 Nat.divmod: nat -> nat -> nat -> nat -> nat * nat
-
 h: n <> newdef n
 h: n <> newdef n
 h: P n
diff --git a/test-suite/output/ShowProof.out b/test-suite/output/ShowProof.out
new file mode 100644
index 000000000..2d4be8bce
--- /dev/null
+++ b/test-suite/output/ShowProof.out
@@ -0,0 +1 @@
+(fun x : Type => conj I ?Goal)
diff --git a/test-suite/output/ShowProof.v b/test-suite/output/ShowProof.v
new file mode 100644
index 000000000..73ecaf220
--- /dev/null
+++ b/test-suite/output/ShowProof.v
@@ -0,0 +1,6 @@
+(* Was #4524 *)
+Definition foo (x : Type) : True /\ True.
+Proof.
+split.
+- exact I.
+  Show Proof. (* Was not finding an evar name at some time *)
diff --git a/test-suite/output/Tactics.out b/test-suite/output/Tactics.out
index 9949658c4..239edd1da 100644
--- a/test-suite/output/Tactics.out
+++ b/test-suite/output/Tactics.out
@@ -1,4 +1,4 @@
 Ltac f H := split; [ a H | e H ]
 Ltac g := match goal with
-          | |- context [if ?X then _ else _] => case X
+          | |- context [ if ?X then _ else _ ] => case X
           end
diff --git a/test-suite/output/auto.out b/test-suite/output/auto.out
new file mode 100644
index 000000000..a5b55a999
--- /dev/null
+++ b/test-suite/output/auto.out
@@ -0,0 +1,20 @@
+(* info auto: *)
+simple apply or_intror (in core).
+ intro.
+ assumption.
+Debug: (* debug auto: *)
+Debug: * assumption. (*fail*)
+Debug: * intro. (*fail*)
+Debug: * simple apply or_intror (in core). (*success*)
+Debug: ** assumption. (*fail*)
+Debug: ** intro. (*success*)
+Debug: ** assumption. (*success*)
+(* info eauto: *)
+simple apply or_intror.
+ intro.
+ exact H.
+Debug: (* debug eauto: *)
+Debug: 1 depth=5 
+Debug: 1.1 depth=4 simple apply or_intror
+Debug: 1.1.1 depth=4 intro
+Debug: 1.1.1.1 depth=4 exact H
diff --git a/test-suite/output/auto.v b/test-suite/output/auto.v
new file mode 100644
index 000000000..a77b7b82e
--- /dev/null
+++ b/test-suite/output/auto.v
@@ -0,0 +1,11 @@
+(* testing info/debug auto/eauto *)
+
+Goal False \/ (True -> True).
+info_auto.
+Undo.
+debug auto.
+Undo.
+info_eauto.
+Undo.
+debug eauto.
+Qed.
diff --git a/test-suite/output/inference.v b/test-suite/output/inference.v
index cd9a4a12b..1825db167 100644
--- a/test-suite/output/inference.v
+++ b/test-suite/output/inference.v
@@ -14,6 +14,7 @@ Definition P (e:option L) :=
 Print P.
 
 (* Check that plus is folded even if reduction is involved *)
+Set Refolding Reduction.
 Check (fun m n p (H : S m <= (S n) + p) => le_S_n _ _ H).
 
 
diff --git a/test-suite/output/ltac.out b/test-suite/output/ltac.out
index 20e274e25..1ff09e3af 100644
--- a/test-suite/output/ltac.out
+++ b/test-suite/output/ltac.out
@@ -1,5 +1,34 @@
 The command has indeed failed with message:
-Error: Ltac variable y depends on pattern variable name z which is not bound in current context.
+Error:
+Ltac variable y depends on pattern variable name z which is not bound in current context.
 Ltac f x y z :=
   symmetry in x, y; auto with z; auto; intros **; clearbody x; generalize
    dependent z
+The command has indeed failed with message:
+In nested Ltac calls to "g1" and "refine (uconstr)", last call failed.
+The term "I" has type "True" while it is expected to have type "False".
+The command has indeed failed with message:
+In nested Ltac calls to "f1 (constr)" and "refine (uconstr)", last call
+failed.
+The term "I" has type "True" while it is expected to have type "False".
+The command has indeed failed with message:
+In nested Ltac calls to "g2 (constr)", "g1" and "refine (uconstr)", last call
+failed.
+The term "I" has type "True" while it is expected to have type "False".
+The command has indeed failed with message:
+In nested Ltac calls to "f2", "f1 (constr)" and "refine (uconstr)", last call
+failed.
+The term "I" has type "True" while it is expected to have type "False".
+The command has indeed failed with message:
+In nested Ltac calls to "h" and "injection (destruction_arg)", last call
+failed.
+Error: No primitive equality found.
+The command has indeed failed with message:
+In nested Ltac calls to "h" and "injection (destruction_arg)", last call
+failed.
+Error: No primitive equality found.
+Hx
+nat
+nat
+0
+0
diff --git a/test-suite/output/ltac.v b/test-suite/output/ltac.v
index 373b870b9..76c37625a 100644
--- a/test-suite/output/ltac.v
+++ b/test-suite/output/ltac.v
@@ -25,3 +25,35 @@ Ltac f x y z :=
   generalize dependent z.
 
 Print Ltac f.
+
+(* Error messages *)
+
+Ltac g1 x := refine x.
+Tactic Notation "g2" constr(x) := g1 x.
+Tactic Notation "f1" constr(x) := refine x.
+Ltac f2 x := f1 x.
+Goal False.
+Fail g1 I.
+Fail f1 I.
+Fail g2 I.
+Fail f2 I.
+
+Ltac h x := injection x.
+Goal True -> False.
+Fail h I.
+intro H.
+Fail h H.
+
+(* Check printing of the "var" argument "Hx" *)
+Ltac m H := idtac H; exact H.
+Goal True.
+let a:=constr:(let Hx := 0 in ltac:(m Hx)) in idtac.
+
+(* Check consistency of interpretation scopes (#4398) *)
+
+Goal nat*(0*0=0) -> nat*(0*0=0). intro.
+match goal with H: ?x*?y |- _ => idtac x end.
+match goal with |- ?x*?y => idtac x end.
+match goal with H: context [?x*?y] |- _ => idtac x end.
+match goal with |- context [?x*?y] => idtac x end.
+Abort.
diff --git a/test-suite/output/onlyprinting.out b/test-suite/output/onlyprinting.out
new file mode 100644
index 000000000..e0a30fcf6
--- /dev/null
+++ b/test-suite/output/onlyprinting.out
@@ -0,0 +1,2 @@
+0:-) 0
+     : nat
diff --git a/test-suite/output/onlyprinting.v b/test-suite/output/onlyprinting.v
new file mode 100644
index 000000000..1973385a0
--- /dev/null
+++ b/test-suite/output/onlyprinting.v
@@ -0,0 +1,5 @@
+Reserved Notation "x :-) y" (at level 50, only printing).
+
+Notation "x :-) y" := (plus x y).
+
+Check 0 + 0.
diff --git a/test-suite/output/qualification.out b/test-suite/output/qualification.out
new file mode 100644
index 000000000..9300c3f54
--- /dev/null
+++ b/test-suite/output/qualification.out
@@ -0,0 +1,3 @@
+File "stdin", line 19, characters 0-7:
+Error: Signature components for label test do not match: expected type
+"Top.M2.t = Top.M2.M.t" but found type "Top.M2.t = Top.M2.t".
diff --git a/test-suite/output/qualification.v b/test-suite/output/qualification.v
new file mode 100644
index 000000000..d39097e2d
--- /dev/null
+++ b/test-suite/output/qualification.v
@@ -0,0 +1,19 @@
+Module Type T1.
+  Parameter t : Type.
+End T1.
+
+Module Type T2.
+  Declare Module M : T1.
+  Parameter t : Type.
+  Parameter test : t = M.t.
+End T2.
+
+Module M1 <: T1.
+  Definition t : Type := bool.
+End M1.
+
+Module M2 <: T2.
+  Module M := M1.
+  Definition t : Type := nat.
+  Lemma test : t = t. Proof. reflexivity. Qed.
+End M2.
diff --git a/test-suite/output/unifconstraints.out b/test-suite/output/unifconstraints.out
new file mode 100644
index 000000000..ae8460362
--- /dev/null
+++ b/test-suite/output/unifconstraints.out
@@ -0,0 +1,65 @@
+3 focused subgoals
+(shelved: 1)
+  
+  ============================
+  ?Goal 0
+
+subgoal 2 is:
+ forall n : nat, ?Goal n -> ?Goal (S n)
+subgoal 3 is:
+ nat
+unification constraint:
+ ?Goal ?Goal2 <=
+   True /\ True /\ True \/
+   veeryyyyyyyyyyyyloooooooooooooonggidentifier =
+   veeryyyyyyyyyyyyloooooooooooooonggidentifier
+3 focused subgoals
+(shelved: 1)
+  
+  n, m : nat
+  ============================
+  ?Goal@{n:=n; m:=m} 0
+
+subgoal 2 is:
+ forall n0 : nat, ?Goal@{n:=n; m:=m} n0 -> ?Goal@{n:=n; m:=m} (S n0)
+subgoal 3 is:
+ nat
+unification constraint:
+ ?Goal@{n:=n; m:=m} ?Goal2@{n:=n; m:=m} <=
+   True /\ True /\ True \/
+   veeryyyyyyyyyyyyloooooooooooooonggidentifier =
+   veeryyyyyyyyyyyyloooooooooooooonggidentifier
+3 focused subgoals
+(shelved: 1)
+  
+  m : nat
+  ============================
+  ?Goal1@{m:=m} 0
+
+subgoal 2 is:
+ forall n0 : nat, ?Goal1@{m:=m} n0 -> ?Goal1@{m:=m} (S n0)
+subgoal 3 is:
+ nat
+unification constraint:
+ 
+ n, m : nat |- ?Goal1@{m:=m} ?Goal0@{n:=n; m:=m} <=
+   True /\ True /\ True \/
+   veeryyyyyyyyyyyyloooooooooooooonggidentifier =
+   veeryyyyyyyyyyyyloooooooooooooonggidentifier
+3 focused subgoals
+(shelved: 1)
+  
+  m : nat
+  ============================
+  ?Goal0@{m:=m} 0
+
+subgoal 2 is:
+ forall n0 : nat, ?Goal0@{m:=m} n0 -> ?Goal0@{m:=m} (S n0)
+subgoal 3 is:
+ nat
+unification constraint:
+ 
+ n, m : nat |- ?Goal0@{m:=m} ?Goal2@{n:=n} <=
+   True /\ True /\ True \/
+   veeryyyyyyyyyyyyloooooooooooooonggidentifier =
+   veeryyyyyyyyyyyyloooooooooooooonggidentifier
diff --git a/test-suite/output/unifconstraints.v b/test-suite/output/unifconstraints.v
new file mode 100644
index 000000000..b9413a4ac
--- /dev/null
+++ b/test-suite/output/unifconstraints.v
@@ -0,0 +1,22 @@
+(* Set Printing Existential Instances. *)
+Unset Solve Unification Constraints.
+Axiom veeryyyyyyyyyyyyloooooooooooooonggidentifier : nat.
+Goal True /\ True /\ True \/
+             veeryyyyyyyyyyyyloooooooooooooonggidentifier =
+             veeryyyyyyyyyyyyloooooooooooooonggidentifier.
+  refine (nat_rect _ _ _ _).
+  Show.
+Admitted.
+
+Set Printing Existential Instances.
+Goal forall n m : nat, True /\ True /\ True \/
+                        veeryyyyyyyyyyyyloooooooooooooonggidentifier =
+                        veeryyyyyyyyyyyyloooooooooooooonggidentifier.
+  intros.
+  refine (nat_rect _ _ _ _).
+  Show.
+  clear n. 
+  Show.
+  3:clear m.
+  Show.
+Admitted.
diff --git a/test-suite/success/Case13.v b/test-suite/success/Case13.v
index f14725a8e..8f95484cf 100644
--- a/test-suite/success/Case13.v
+++ b/test-suite/success/Case13.v
@@ -55,6 +55,14 @@ Check (fun x : I' 0 => match x with
                        | _ => 0
                        end).
 
+(* This one could eventually be solved, the "Fail" is just to ensure *)
+(* that it does not fail with an anomaly, as it did at some time *)
+Fail Check (fun x : I' 0 => match x return _ x with
+                       | C2' _ _ => 0
+                       | niln => 0
+                       | _ => 0
+                       end).
+
 (* Check insertion of coercions around matched subterm *)
 
 Parameter A:Set.
diff --git a/test-suite/success/Case22.v b/test-suite/success/Case22.v
index 3c696502c..465b3eb8c 100644
--- a/test-suite/success/Case22.v
+++ b/test-suite/success/Case22.v
@@ -41,6 +41,7 @@ Definition F (x:IND True) (A:Type) :=
 Theorem paradox : False.
   (* This succeeded in 8.3, 8.4 and 8.5beta1 because F had wrong type *)
 Fail Proof (F C False).
+Abort.
 
 (* Another bug found in November 2015 (a substitution was wrongly
    reversed at pretyping level) *)
@@ -61,3 +62,30 @@ Inductive Ind2 (b:=1) (c:nat) : Type :=
   Constr2 : Ind2 c.
 
 Eval vm_compute in Constr2 2.
+
+(* A bug introduced in ade2363 (similar to #5322 and #5324). This
+   commit started to see that some List.rev was wrong in the "var"
+   case of a pattern-matching problem but it failed to see that a
+   transformation from a list of arguments into a substitution was
+   still needed. *)
+
+(* The order of real arguments was made wrong by ade2363 in the "var"
+   case of the compilation of "match" *)
+
+Inductive IND2 : forall X Y:Type, Type :=
+  CONSTR2 : IND2 unit Empty_set.
+
+Check fun x:IND2 bool nat =>
+  match x in IND2 a b return a with
+  | y => _
+  end = true.
+
+(* From January 2017, using the proper function to turn arguments into
+   a substitution up to a context possibly containing let-ins, so that
+   the following, which was wrong also before ade2363, now works
+   correctly *)
+
+Check fun x:Ind bool nat =>
+  match x in Ind _ X Y Z return Z with
+  | y => (true,0)
+  end.
diff --git a/test-suite/success/CaseInClause.v b/test-suite/success/CaseInClause.v
index 599b9566c..6424fe92d 100644
--- a/test-suite/success/CaseInClause.v
+++ b/test-suite/success/CaseInClause.v
@@ -24,3 +24,6 @@ Theorem foo : forall (n m : nat) (pf : n = m),
 (* Check redundant clause is removed *)
 Inductive I : nat * nat -> Type := C : I (0,0).
 Check fun x : I (1,1) => match x in I (y,z) return y = z with C => eq_refl end.
+
+(* An example of non-local inference of the type of an impossible case *)
+Check (fun y n (x:Vector.t nat (S n)) => match x with a::_ => a | _ => y end) 2.
diff --git a/test-suite/success/Discriminate.v b/test-suite/success/Discriminate.v
index a75967411..6abfca4c3 100644
--- a/test-suite/success/Discriminate.v
+++ b/test-suite/success/Discriminate.v
@@ -38,3 +38,10 @@ Abort.
 Goal ~ identity 0 1.
 discriminate.
 Qed.
+
+(* Check discriminate on types with local definitions *)
+
+Inductive A := B (T := unit) (x y : bool) (z := x).
+Goal forall x y, B x true = B y false -> False.
+discriminate.
+Qed.
diff --git a/test-suite/success/Hints.v b/test-suite/success/Hints.v
index f934a5c74..1abe14774 100644
--- a/test-suite/success/Hints.v
+++ b/test-suite/success/Hints.v
@@ -1,4 +1,12 @@
 (* Checks syntax of Hints commands *)
+(* Old-style syntax *)
+Hint Resolve eq_refl eq_sym.
+Hint Resolve eq_refl eq_sym: foo.
+Hint Immediate eq_refl eq_sym.
+Hint Immediate eq_refl eq_sym: foo.
+Hint Unfold fst eq_sym.
+Hint Unfold fst eq_sym: foo.
+
 (* Checks that qualified names are accepted *)
 
 (* New-style syntax *)
@@ -8,13 +16,76 @@ Hint Unfold eq_sym: core.
 Hint Constructors eq: foo bar.
 Hint Extern 3 (_ = _) => apply eq_refl: foo bar.
 
-(* Old-style syntax *)
-Hint Resolve eq_refl eq_sym.
-Hint Resolve eq_refl eq_sym: foo.
-Hint Immediate eq_refl eq_sym.
-Hint Immediate eq_refl eq_sym: foo.
-Hint Unfold fst eq_sym.
-Hint Unfold fst eq_sym: foo.
+(* Extended new syntax with patterns *)
+Hint Resolve eq_refl | 4 (_ = _) : baz.
+Hint Resolve eq_sym eq_trans : baz.
+Hint Extern 3 (_ = _) => apply eq_sym : baz.
+
+Parameter pred : nat -> Prop.
+Parameter pred0 : pred 0.
+Parameter f : nat -> nat.
+Parameter predf : forall n, pred n -> pred (f n).
+
+(* No conversion on let-bound variables and constants in pred (the default) *)
+Hint Resolve pred0 | 1 (pred _) : pred.
+Hint Resolve predf | 0 : pred.
+
+(* Allow full conversion on let-bound variables and constants *)
+Create HintDb predconv discriminated.
+Hint Resolve pred0 | 1 (pred _) : predconv.
+Hint Resolve predf | 0 : predconv.
+
+Goal exists n, pred n.
+  eexists.
+  Fail Timeout 1 typeclasses eauto with pred.
+  Set Typeclasses Filtered Unification.
+  Set Typeclasses Debug Verbosity 2.
+  (* predf is not tried as it doesn't match the goal *)
+  typeclasses eauto with pred.
+Qed.
+
+Parameter predconv : forall n, pred n -> pred (0 + S n).
+
+(* The inferred pattern contains 0 + ?n, syntactic match will fail to see convertible
+ terms *)
+Hint Resolve pred0 : pred2.
+Hint Resolve predconv : pred2.
+
+(** In this database we allow predconv to apply to pred (S _) goals, more generally
+  than the inferred pattern (pred (0 + S _)). *)
+Create HintDb pred2conv discriminated.
+Hint Resolve pred0 : pred2conv.
+Hint Resolve predconv | 1 (pred (S _)) : pred2conv.
+
+Goal pred 3.
+  Fail typeclasses eauto with pred2.
+  typeclasses eauto with pred2conv.
+Abort.
+
+Set Typeclasses Filtered Unification.
+Set Typeclasses Debug Verbosity 2.
+Hint Resolve predconv | 1 (pred _) : pred.
+Hint Resolve predconv | 1 (pred (S _)) : predconv.
+Test Typeclasses Limit Intros.
+Goal pred 3.
+  (* predf is not tried as it doesn't match the goal *)
+  (* predconv is tried but fails as the transparent state doesn't allow
+     unfolding + *)
+  Fail typeclasses eauto with pred.
+  (* Here predconv succeeds as it matches (pred (S _)) and then
+     full unification is allowed *)
+  typeclasses eauto with predconv.
+Qed.
+
+(** The other way around: goal contains redexes instead of instances *)
+Goal exists n, pred (0 + n).
+  eexists.
+  (* predf is applied indefinitely *)
+  Fail Timeout 1 typeclasses eauto with pred.
+  (* pred0 (pred _) matches the goal *)
+  typeclasses eauto with predconv.
+Qed.
+
 
 (* Checks that local names are accepted *)
 Section A.
@@ -100,9 +171,9 @@ Instance foo f :
 Proof.
   Fail Timeout 1 apply _. (* 3.7s *)
   
-Hint Cut [!*; (a_is_b | b_is_c | c_is_d | d_is_e) ;
-  (a_compose | b_compose | c_compose | d_compose | e_compose)] : typeclass_instances.
+Hint Cut [_* (a_is_b | b_is_c | c_is_d | d_is_e)
+                 (a_compose | b_compose | c_compose | d_compose | e_compose)] : typeclass_instances.
 
   Timeout 1 Fail apply _. (* 0.06s *)
 Abort.
-End HintCut.
\ No newline at end of file
+End HintCut.
diff --git a/test-suite/success/Inductive.v b/test-suite/success/Inductive.v
index 9661b3bfa..f746def5c 100644
--- a/test-suite/success/Inductive.v
+++ b/test-suite/success/Inductive.v
@@ -162,3 +162,24 @@ Inductive L (A:Type) (T:=A) : Type := C : L nat -> L A.
    hit the Inductiveops.get_arity bug mentioned above (see #3491) *)
 
 Inductive IND6 (A:Type) (T:=A) := CONS6 : IND6 T -> IND6 A.
+
+
+Module TemplateProp.
+
+  (** Check lowering of a template universe polymorphic inductive to Prop *)
+  
+  Inductive Foo (A : Type) : Type := foo : A -> Foo A.
+  
+  Check Foo True : Prop.
+
+End TemplateProp.
+
+Module PolyNoLowerProp.
+
+  (** Check lowering of a general universe polymorphic inductive to Prop is _failing_ *)
+  
+  Polymorphic Inductive Foo (A : Type) : Type := foo : A -> Foo A.
+  
+  Fail Check Foo True : Prop.
+
+End PolyNoLowerProp.
diff --git a/test-suite/success/Injection.v b/test-suite/success/Injection.v
index 56ed89ed8..78652fb64 100644
--- a/test-suite/success/Injection.v
+++ b/test-suite/success/Injection.v
@@ -4,6 +4,7 @@ Require Eqdep_dec.
 
 (* Check that Injection tries Intro until *)
 
+Unset Structural Injection.
 Lemma l1 : forall x : nat, S x = S (S x) -> False.
  injection 1.
 apply n_Sn.
@@ -37,6 +38,7 @@ intros.
  injection H.
 exact (fun H => H).
 Qed.
+Set Structural Injection.
 
 (* Test injection as *)
 
@@ -65,7 +67,7 @@ Qed.
 Goal (forall x y : nat, x = y -> S x = S y) -> True.
 intros.
 einjection (H O).
-instantiate (1:=O).
+2:instantiate (1:=O).
 Abort.
 
 Goal (forall x y : nat, x = y -> S x = S y) -> True.
@@ -85,12 +87,21 @@ Qed.
 (* Basic case, using sigT *)
 
 Scheme Equality for nat.
+Unset Structural Injection.
 Goal forall n:nat, forall P:nat -> Type, forall H1 H2:P n,
   existT P n H1 = existT P n H2 -> H1 = H2.
 intros.
 injection H.
 intro H0. exact H0.
 Abort.
+Set Structural Injection.
+
+Goal forall n:nat, forall P:nat -> Type, forall H1 H2:P n,
+  existT P n H1 = existT P n H2 -> H1 = H2.
+intros.
+injection H as H0.
+exact H0.
+Abort.
 
 (* Test injection using K, knowing that an equality is decidable *)
 (* Basic case, using sigT, with "as" clause *)
@@ -124,7 +135,29 @@ intros * [= H].
 exact H.
 Abort.
 
-(* Injection does not projects at positions in Prop... allow it?
+(* Test the Keep Proof Equalities option. *)
+Set Keep Proof Equalities.
+Unset Structural Injection.
+
+Inductive pbool : Prop := Pbool1 | Pbool2.
+
+Inductive pbool_shell : Set := Pbsc : pbool -> pbool_shell.
+
+Goal Pbsc Pbool1 = Pbsc Pbool2 -> True.
+injection 1.
+match goal with
+ |- Pbool1 = Pbool2 -> True => idtac | |- True => fail
+end.
+Abort.
+
+(* Injection in the presence of local definitions *)
+Inductive A := B (T := unit) (x y : bool) (z := x).
+Goal forall x y x' y', B x y = B x' y' -> y = y'.
+intros * [= H1 H2].
+exact H2.
+Qed.
+
+(* Injection does not project at positions in Prop... allow it?
 
 Inductive t (A:Prop) : Set := c : A -> t A.
 Goal forall p q : True\/True, c _ p = c _ q -> False.
diff --git a/test-suite/success/Notations.v b/test-suite/success/Notations.v
index b72a06740..07bbb60c4 100644
--- a/test-suite/success/Notations.v
+++ b/test-suite/success/Notations.v
@@ -58,7 +58,7 @@ Check (fun x:nat*nat => match x with R x y => (x,y) end).
 
 (* Check multi-tokens recursive notations *)
 
-Local Notation "[ a  # ; ..  # ; b ]" := (a + .. (b + 0) ..).   
+Local Notation "[ a  # ; ..  # ; b ]" := (a + .. (b + 0) ..).
 Check [ 0 ].
 Check [ 0 # ; 1 ].
 
@@ -107,3 +107,24 @@ Notation traverse_var f l := (traverse (fun l => f l) l).
 
 Notation "'intros' x" := (S x) (at level 0).
 Goal True -> True. intros H. exact H. Qed.
+
+(* Check absence of collision on ".." in nested notations with ".." *)
+Notation "[ a , .. , b ]" := (a, (.. (b,tt) ..)).
+
+(* Check that vector notations do not break Ltac [] (bugs #4785, #4733) *)
+Require Import Coq.Vectors.VectorDef.
+Import VectorNotations.
+Goal True. idtac; []. (* important for test: no space here *) constructor. Qed.
+
+(* Check parsing of { and } is not affected by notations #3479 *)
+Notation " |- {{ a }} b" := (a=b) (no associativity, at level 10).
+Goal True.
+{{ exact I. }}
+Qed.
+Check |- {{ 0 }} 0.
+
+(* Check parsing of { and } is not affected by notations #3479 *)
+Notation " |- {{ a }} b" := (a=b) (no associativity, at level 10).
+Goal True.
+{{ exact I. }}
+Qed.
diff --git a/test-suite/success/PatternsInBinders.v b/test-suite/success/PatternsInBinders.v
new file mode 100644
index 000000000..777107915
--- /dev/null
+++ b/test-suite/success/PatternsInBinders.v
@@ -0,0 +1,67 @@
+(** The purpose of this file is to test functional properties of the
+    destructive patterns used in binders ([fun] and [forall]). *)
+
+
+Definition swap {A B} '((x,y) : A*B) := (y,x).
+
+(** Tests the use of patterns in [fun] and [Definition] *)
+Section TestFun.
+
+  Variables A B : Type.
+
+  Goal forall (x:A) (y:B), swap (x,y) = (y,x).
+  Proof. reflexivity. Qed.
+
+  Goal forall u:A*B, swap (swap u) = u.
+  Proof. destruct u. reflexivity. Qed.
+
+  Goal @swap A B = fun '(x,y) => (y,x).
+  Proof. reflexivity. Qed.
+
+End TestFun.
+
+
+(** Tests the use of patterns in [forall] *)
+Section TestForall.
+
+  Variables A B : Type.
+
+  Goal forall '((x,y) : A*B), swap (x,y) = (y,x).
+  Proof. intros [x y]. reflexivity. Qed.
+
+  Goal forall x0:A, exists '((x,y) : A*A), swap (x,y) = (x,y).
+  Proof.
+    intros x0.
+    exists (x0,x0).
+    reflexivity.
+  Qed.
+
+End TestForall.
+
+
+
+(** Tests the use of patterns in dependent definitions. *)
+
+Section TestDependent.
+
+  Inductive Fin (n:nat) := Z : Fin n.
+
+  Definition F '(n,p) : Type := (Fin n * Fin p)%type.
+
+  Definition both_z '(n,p) : F (n,p) := (Z _,Z _).
+
+End TestDependent.
+
+
+(** Tests with a few other types just to make sure parsing is
+    robust. *)
+Section TestExtra.
+
+  Definition proj_informative {A P} '(exist _ x _ : { x:A | P x }) : A := x.
+
+  Inductive Foo := Bar : nat -> bool -> unit -> nat -> Foo.
+
+  Definition foo '(Bar n b tt p) :=
+    if b then n+p else n-p.
+
+End TestExtra.
diff --git a/test-suite/success/RecTutorial.v b/test-suite/success/RecTutorial.v
index 11fbf24d4..d8f804246 100644
--- a/test-suite/success/RecTutorial.v
+++ b/test-suite/success/RecTutorial.v
@@ -831,7 +831,7 @@ Proof.
  intro n.
  apply nat_ind with (P:= fun n => n <> S n).
  discriminate.
- red; intros n0 Hn0 eqn0Sn0;injection eqn0Sn0;trivial.
+ red; intros n0 Hn0 eqn0Sn0;injection eqn0Sn0;auto.
 Qed.
 
 Definition eq_nat_dec : forall n p:nat , {n=p}+{n <> p}.
@@ -1075,8 +1075,8 @@ Proof.
  apply vector_double_rect.
  simpl.
  destruct i; discriminate 1.
- destruct i; simpl;auto.
- injection 1; injection 2;intros; subst a; subst b; auto.
+ destruct i; simpl;auto. 
+ injection 1 as ->; injection 1 as ->; auto.
 Qed.
 
  Set Implicit Arguments.
diff --git a/test-suite/success/TestRefine.v b/test-suite/success/TestRefine.v
index c8a8b862f..023cb5f59 100644
--- a/test-suite/success/TestRefine.v
+++ b/test-suite/success/TestRefine.v
@@ -53,7 +53,7 @@ Abort.
 
 Lemma essai2 : forall x : nat, x = x.
 
-Fail refine (fix f (x : nat) : x = x := _).
+refine (fix f (x : nat) : x = x := _).
 
 Restart.
 
diff --git a/test-suite/success/Typeclasses.v b/test-suite/success/Typeclasses.v
index d6e590af3..6b1f0315b 100644
--- a/test-suite/success/Typeclasses.v
+++ b/test-suite/success/Typeclasses.v
@@ -1,3 +1,117 @@
+Module onlyclasses.
+
+(* In 8.6 we still allow non-class subgoals *)
+  Variable Foo : Type.
+  Variable foo : Foo.
+  Hint Extern 0 Foo => exact foo : typeclass_instances.
+  Goal Foo * Foo.
+    split. shelve.
+    Set Typeclasses Debug.
+    typeclasses eauto.
+    Unshelve. typeclasses eauto.
+  Qed.
+
+  Module RJung.
+    Class Foo (x : nat).
+      
+      Instance foo x : x = 2 -> Foo x.
+      Hint Extern 0 (_ = _) => reflexivity : typeclass_instances.
+      Typeclasses eauto := debug.
+      Check (_ : Foo 2).
+
+
+      Fail Definition foo := (_ : 0 = 0).
+
+  End RJung.
+End onlyclasses.
+
+Module shelve_non_class_subgoals.
+  Variable Foo : Type.
+  Variable foo : Foo.
+  Hint Extern 0 Foo => exact foo : typeclass_instances.
+  Class Bar := {}.
+  Instance bar1 (f:Foo) : Bar := {}.
+
+  Typeclasses eauto := debug.
+  Set Typeclasses Debug Verbosity 2.
+  Goal Bar.
+    (* Solution has shelved subgoals (of non typeclass type) *)
+    typeclasses eauto.
+  Abort.
+End shelve_non_class_subgoals.
+
+Module RefineVsNoTceauto.
+
+  Class Foo (A : Type) := foo : A.
+  Instance: Foo nat := { foo := 0 }.
+  Instance: Foo nat := { foo := 42 }.
+  Hint Extern 0 (_ = _) => refine eq_refl : typeclass_instances.
+  Goal exists (f : Foo nat), @foo _ f = 0.
+  Proof.
+    unshelve (notypeclasses refine (ex_intro _ _ _)). 
+    Set Typeclasses Debug. Set Printing All.
+    all:once (typeclasses eauto).
+    Fail idtac. (* Check no subgoals are left *)
+    Undo 3.
+    (** In this case, the (_ = _) subgoal is not considered 
+        by typeclass resolution *)
+    refine (ex_intro _ _ _). Fail reflexivity.
+  Abort.
+
+End RefineVsNoTceauto.
+
+Module Leivantex2PR339.
+  (** Was a bug preventing to find hints associated with no pattern *)
+  Class Bar := {}.
+  Instance bar1 (t:Type) : Bar.
+  Hint Extern 0 => exact True : typeclass_instances.
+  Typeclasses eauto := debug.
+  Goal Bar.
+    Set Typeclasses Debug Verbosity 2.
+    typeclasses eauto. (* Relies on resolution of a non-class subgoal *)
+    Undo 1.
+    typeclasses eauto with typeclass_instances.
+  Qed.
+End Leivantex2PR339.
+
+Module bt.
+Require Import Equivalence.
+
+Record Equ (A : Type) (R : A -> A -> Prop).
+Definition equiv {A} R (e : Equ A R) := R.
+Record Refl (A : Type) (R : A -> A -> Prop).
+Axiom equ_refl : forall A R (e : Equ A R), Refl _ (@equiv A R e).
+Hint Extern 0 (Refl _ _) => unshelve class_apply @equ_refl; [shelve|] : foo.
+
+Variable R : nat -> nat -> Prop.
+Lemma bas : Equ nat R.
+Admitted.
+Hint Resolve bas : foo.
+Hint Extern 1 => match goal with |- (_ -> _ -> Prop) => shelve end : foo.
+
+Goal exists R, @Refl nat R.
+  eexists.
+  Set Typeclasses Debug.
+  (* Fail solve [unshelve eauto with foo]. *)
+  Set Typeclasses Debug Verbosity 1.
+  Test Typeclasses Depth.
+  solve [typeclasses eauto with foo].
+Qed.
+
+Set Typeclasses Compatibility "8.5".
+Parameter f : nat -> Prop.
+Parameter g : nat -> nat -> Prop.
+Parameter h : nat -> nat -> nat -> Prop.
+Axiom a : forall x y, g x y -> f x -> f y.
+Axiom b : forall x (y : Empty_set), g (fst (x,y)) x.
+Axiom c : forall x y z, h x y z -> f x -> f y.
+Hint Resolve a b c : mybase.
+Goal forall x y z, h x y z -> f x -> f y.
+  intros.
+  Fail Timeout 1 typeclasses eauto with mybase. (* Loops now *)
+  Unshelve.
+Abort.
+End bt.
 Generalizable All Variables.
 
 Module mon.
@@ -23,8 +137,15 @@ Notation "'return' t" := (unit t).
 Class A `(e: T) := { a := True }.
 Class B `(e_: T) := { e := e_; sg_ass :> A e }.
 
-Goal forall `{B T}, a.
-  intros. exact I.
+(* Set Typeclasses Debug. *)
+(* Set Typeclasses Debug Verbosity 2. *)
+
+Goal forall `{B T}, Prop.
+  intros. apply a.
+Defined.
+
+Goal forall `{B T}, Prop.
+  intros. refine (@a _ _ _).
 Defined.
 
 Class B' `(e_: T) := { e' := e_; sg_ass' :> A e_ }.
@@ -59,6 +180,40 @@ Section sec.
  Check U (fun x => e x) _.
 End sec.
 
+Module UniqueSolutions.
+  Set Typeclasses Unique Solutions.
+  Class Eq (A : Type) : Set.
+    Instance eqa : Eq nat := {}.
+    Instance eqb : Eq nat := {}.
+
+    Goal Eq nat.
+      try apply _.
+      Fail exactly_once typeclasses eauto.
+    Abort.
+End UniqueSolutions.
+
+
+Module UniqueInstances.
+  (** Optimize proof search on this class by never backtracking on (closed) goals
+      for it. *)
+  Set Typeclasses Unique Instances.
+  Class Eq (A : Type) : Set.
+    Instance eqa : Eq nat := _. constructor. Qed.
+    Instance eqb : Eq nat := {}.
+    Class Foo (A : Type) (e : Eq A) : Set.
+    Instance fooa : Foo _ eqa := {}.
+
+    Tactic Notation "refineu" open_constr(c) := unshelve refine c.
+
+    Set Typeclasses Debug.
+    Goal { e : Eq nat & Foo nat e }.
+      unshelve refineu (existT _ _ _).
+      all:simpl.
+      (** Does not backtrack on the (wrong) solution eqb *)
+      Fail all:typeclasses eauto.
+    Abort.
+End UniqueInstances.
+
 Module IterativeDeepening.
 
   Class A.
@@ -75,6 +230,12 @@ Module IterativeDeepening.
     Set Typeclasses Debug.
     Fail Timeout 1 typeclasses eauto.
     Set Typeclasses Iterative Deepening.
+    Fail typeclasses eauto 1.
+    typeclasses eauto 2.
+    Undo.
+    Unset Typeclasses Iterative Deepening.
+    Fail Timeout 1 typeclasses eauto.
+    Set Typeclasses Iterative Deepening.
     typeclasses eauto.
   Qed.
 
diff --git a/test-suite/success/bteauto.v b/test-suite/success/bteauto.v
new file mode 100644
index 000000000..3178c6fc1
--- /dev/null
+++ b/test-suite/success/bteauto.v
@@ -0,0 +1,170 @@
+Require Import Program.Tactics.
+Module Backtracking.
+  Class A := { foo : nat }.
+
+  Instance A_1 : A | 2 := { foo := 42 }.
+  Instance A_0 : A | 1 := { foo := 0 }.
+  Lemma aeq (a : A) : foo = foo.
+    reflexivity.
+  Qed.
+  
+  Arguments foo A : clear implicits.
+  Example find42 : exists n, n = 42.
+  Proof.
+    eexists.
+    eapply eq_trans.
+    evar (a : A). subst a.
+    refine (@aeq ?a).
+    Unshelve. all:cycle 1.
+    typeclasses eauto.
+    Fail reflexivity. 
+    Undo 2.
+    (* Without multiple successes it fails *)
+    Set Typeclasses Debug Verbosity 2.
+    Fail all:((once (typeclasses eauto with typeclass_instances))
+              + apply eq_refl).
+    (* Does backtrack if other goals fail *)
+    all:[> typeclasses eauto + reflexivity .. ].
+    Undo 1.
+    all:(typeclasses eauto + reflexivity). (* Note "+" is a focussing combinator *)
+    Show Proof.  
+  Qed.
+
+  Print find42.
+  
+  Hint Extern 0 (_ = _) => reflexivity : equality.
+  
+  Goal exists n, n = 42.
+    eexists.
+    eapply eq_trans.
+    evar (a : A). subst a.
+    refine (@aeq ?a).
+    Unshelve. all:cycle 1.
+    typeclasses eauto.
+    Fail reflexivity.
+    Undo 2.
+    
+    (* Does backtrack between individual goals *)
+    Set Typeclasses Debug.
+    all:(typeclasses eauto with typeclass_instances equality).
+  Qed.
+  
+  Unset Typeclasses Debug.
+
+  Module Leivant.
+    Axiom A : Type.
+    Existing Class A.
+    Axioms a b c d e: A.
+    
+    Ltac get_value H := eval cbv delta [H] in H.
+    
+    Goal True.
+      Fail refine (let H := _ : A in _); let v := get_value H in idtac v; fail.
+    Admitted.
+
+    Goal exists x:A, x=a.
+      unshelve evar (t : A). all:cycle 1.
+      refine (@ex_intro _ _ t _).
+      all:cycle 1.
+      all:(typeclasses eauto + reflexivity).
+    Qed.      
+  End Leivant.
+End Backtracking.
+
+
+Hint Resolve 100 eq_sym eq_trans : core.
+Hint Cut [(_)* eq_sym eq_sym] : core.
+Hint Cut [_* eq_trans eq_trans] : core.
+Hint Cut [_* eq_trans eq_sym eq_trans] : core.
+
+
+Goal forall x y z : nat, x = y -> z = y -> x = z.
+Proof.
+  intros.
+  typeclasses eauto with core.
+Qed.
+
+Module Hierarchies.
+  Class A := mkA { data : nat }.
+  Class B := mkB { aofb :> A }.
+
+  Existing Instance mkB.
+
+  Definition makeB (a : A) : B := _.
+  Definition makeA (a : B) : A := _.
+
+  Fail Timeout 1 Definition makeA' : A := _.
+
+  Hint Cut [_* mkB aofb] : typeclass_instances.
+  Fail Definition makeA' : A := _.
+  Fail Definition makeB' : B := _.
+End Hierarchies.
+
+(** Hint modes *)
+
+Class Equality (A : Type) := { eqp : A -> A -> Prop }.
+
+Check (eqp 0%nat 0).
+
+Instance nat_equality : Equality nat := { eqp := eq }.
+
+Instance default_equality A : Equality A | 1000 :=
+  { eqp := eq }.
+
+Check (eqp 0%nat 0).
+
+(* Defaulting *)
+Check (fun x y => eqp x y).
+(* No more defaulting, reduce "trigger-happiness" *)
+Definition ambiguous x y := eqp x y.
+
+Hint Mode Equality ! : typeclass_instances.
+Fail Definition ambiguous' x y := eqp x y.
+Definition nonambiguous (x y : nat) := eqp x y.
+
+(** Typical looping instances with defaulting: *)
+Definition flip {A B C} (f : A -> B -> C) := fun x y => f y x.
+
+Class SomeProp {A : Type} (f : A -> A -> A) :=
+  { prf : forall x y, f x y = f x y }.
+
+Instance propflip (A : Type) (f : A -> A -> A) :
+  SomeProp f -> SomeProp (flip f).
+Proof.
+  intros []. constructor. reflexivity.
+Qed.
+
+Fail Timeout 1 Check prf.
+
+Hint Mode SomeProp + + : typeclass_instances.
+Check prf.
+Check (fun H : SomeProp plus => _ : SomeProp (flip plus)).
+
+(** Iterative deepening / breadth-first search *)
+
+Module IterativeDeepening.
+
+  Class A.
+  Class B.
+  Class C.
+
+  Instance: B -> A | 0.
+  Instance: C -> A | 0.
+  Instance: C -> B -> A | 0.
+  Instance: A -> A | 0.
+  
+  Goal C -> A.
+    intros.
+    Fail Timeout 1 typeclasses eauto.
+    Set Typeclasses Iterative Deepening.
+    Fail typeclasses eauto 1.
+    typeclasses eauto 2.
+    Undo.
+    Unset Typeclasses Iterative Deepening.
+    Fail Timeout 1 typeclasses eauto.
+    Set Typeclasses Iterative Deepening.
+    Typeclasses eauto := debug 3.
+    typeclasses eauto.
+  Qed.
+
+End IterativeDeepening.
diff --git a/test-suite/success/cc.v b/test-suite/success/cc.v
index dc0527d82..bbfe5ec42 100644
--- a/test-suite/success/cc.v
+++ b/test-suite/success/cc.v
@@ -136,3 +136,18 @@ Inductive I : nat -> Type := C : I 0 | D : I 0.
 Goal ~C=D.
 congruence.
 Qed.
+
+(* Example by Jonathan Leivant, congruence up to universes *)
+Section JLeivant.
+  Variables S1 S2 : Set.
+
+  Definition T1 : Type := S1.
+  Definition T2 : Type := S2.
+
+  Goal T1 = T1.
+    congruence.
+    Undo.
+    unfold T1.
+    congruence.
+  Qed.
+End JLeivant.
diff --git a/test-suite/success/clear.v b/test-suite/success/clear.v
index 976bec737..e25510cf0 100644
--- a/test-suite/success/clear.v
+++ b/test-suite/success/clear.v
@@ -13,3 +13,21 @@ Goal forall y z, (forall x:nat, x=y -> True) -> y=z -> True.
   reflexivity.
 Qed.
 
+Class A.
+
+Section Foo.
+
+  Variable a : A.
+
+  Goal A.
+    solve [typeclasses eauto].
+    Undo 1.
+    clear a.
+    try typeclasses eauto.
+    assert(a:=Build_A).
+    solve [ typeclasses eauto ].
+    Undo 2.
+    assert(b:=Build_A).
+    solve [ typeclasses eauto ].
+  Qed.
+End Foo.
\ No newline at end of file
diff --git a/test-suite/success/contradiction.v b/test-suite/success/contradiction.v
new file mode 100644
index 000000000..92a7c6ccb
--- /dev/null
+++ b/test-suite/success/contradiction.v
@@ -0,0 +1,32 @@
+(* Some tests for contradiction *)
+
+Lemma L1 : forall A B : Prop, A -> ~A -> B.
+Proof.
+intros; contradiction.
+Qed.
+
+Lemma L2 : forall A B : Prop, ~A -> A -> B.
+Proof.
+intros; contradiction.
+Qed.
+
+Lemma L3 : forall A : Prop, ~True -> A.
+Proof.
+intros; contradiction.
+Qed.
+
+Lemma L4 : forall A : Prop, forall x : nat, ~x=x -> A.
+Proof.
+intros; contradiction.
+Qed.
+
+Lemma L5 : forall A : Prop, forall x y : nat, ~x=y -> x=y -> A.
+Proof.
+intros; contradiction.
+Qed.
+
+Lemma L6 : forall A : Prop, forall x y : nat, x=y -> ~x=y -> A.
+Proof.
+intros; contradiction.
+Qed.
+
diff --git a/test-suite/success/eauto.v b/test-suite/success/eauto.v
index 773dd321e..160f2d9de 100644
--- a/test-suite/success/eauto.v
+++ b/test-suite/success/eauto.v
@@ -5,6 +5,184 @@
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
+
+Class A (A : Type).
+  Instance an: A nat.
+
+Class B (A : Type) (a : A).
+Instance bn0: B nat 0.
+Instance bn1: B nat 1.
+
+Goal A nat.
+Proof.
+  typeclasses eauto.
+Qed.
+
+Goal B nat 2.
+Proof.
+  Fail typeclasses eauto.
+Abort.
+
+Goal exists T : Type, A T.
+Proof.
+  eexists. typeclasses eauto.
+Defined.
+
+Hint Extern 0 (_ /\ _) => constructor : typeclass_instances.
+
+Existing Class and.
+
+Goal exists (T : Type) (t : T), A T /\ B T t.
+Proof.
+  eexists. eexists. typeclasses eauto.
+Defined.
+
+Instance ab: A bool. (* Backtrack on A instance *)
+Goal exists (T : Type) (t : T), A T /\ B T t.
+Proof.
+  eexists. eexists. typeclasses eauto.
+Defined.
+
+Class C {T} `(a : A T) (t : T). 
+Require Import Classes.Init.
+Hint Extern 0 { x : ?A & _ } =>
+  unshelve class_apply @existT : typeclass_instances.
+Existing Class sigT.
+Set Typeclasses Debug.
+Instance can: C an 0.
+(* Backtrack on instance implementation *)
+Goal exists (T : Type) (t : T), { x : A T & C x t }.
+Proof.
+  eexists. eexists. typeclasses eauto.
+Defined.
+
+Class D T `(a: A T).
+  Instance: D _ an.
+Goal exists (T : Type), { x : A T & D T x }.
+Proof.
+  eexists. typeclasses eauto.
+Defined.
+  
+
+(* 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 :
+ (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.
+  apply H0. apply f_equal_nat.
+  Time info_eauto.
+  Undo.
+  Set Typeclasses Debug.
+  Set Typeclasses Iterative Deepening.
+  Time typeclasses eauto 6 with nocore. Show Proof.
+  Undo.
+  Time eauto. (* does EApply H *)
+Qed.
+
+(* Example from Nicolas Tabareau on coq-club - Feb 2016. 
+  Full backtracking on dependent subgoals.
+ *)
+Require Import Coq.Classes.Init.
+
+Module NTabareau.
+
+Set Typeclasses Dependency Order.
+Unset Typeclasses Iterative Deepening.
+Notation "x .1" := (projT1 x) (at level 3).
+Notation "x .2" := (projT2 x) (at level 3).
+
+Parameter myType: Type. 
+
+Class Foo (a:myType) := {}.
+
+Class Bar (a:myType) := {}.
+
+Class Qux (a:myType) := {}.
+
+Parameter fooTobar : forall a (H : Foo a), {b: myType & Bar b}.
+
+Parameter barToqux : forall a (H : Bar a), {b: myType & Qux b}.
+
+Hint Extern 5 (Bar ?D.1) =>
+    destruct D; simpl : typeclass_instances.
+
+Hint Extern 5 (Qux ?D.1) =>
+    destruct D; simpl : typeclass_instances.
+
+Hint Extern 1 myType =>
+  unshelve refine (fooTobar _ _).1 : typeclass_instances.
+
+Hint Extern 1 myType => unshelve refine (barToqux _ _).1 : typeclass_instances.
+
+Hint Extern 0 { x : _ & _ } => simple refine (existT _ _ _) : typeclass_instances.
+
+Unset Typeclasses Debug.
+Definition trivial a (H : Foo a) : {b : myType & Qux b}. 
+Proof.
+  Time typeclasses eauto 10 with typeclass_instances.
+  Undo. Set Typeclasses Iterative Deepening.
+  Time typeclasses eauto with typeclass_instances.
+Defined.
+
+End NTabareau.
+
+Module NTabareauClasses.
+
+Set Typeclasses Dependency Order.
+Unset Typeclasses Iterative Deepening.
+Notation "x .1" := (projT1 x) (at level 3).
+Notation "x .2" := (projT2 x) (at level 3).
+
+Parameter myType: Type. 
+Existing Class myType.
+
+Class Foo (a:myType) := {}.
+
+Class Bar (a:myType) := {}.
+
+Class Qux (a:myType) := {}.
+
+Parameter fooTobar : forall a (H : Foo a), {b: myType & Bar b}.
+
+Parameter barToqux : forall a (H : Bar a), {b: myType & Qux b}.
+
+Hint Extern 5 (Bar ?D.1) =>
+    destruct D; simpl : typeclass_instances.
+
+Hint Extern 5 (Qux ?D.1) =>
+    destruct D; simpl : typeclass_instances.
+
+Hint Extern 1 myType =>
+  unshelve notypeclasses refine (fooTobar _ _).1 : typeclass_instances.
+
+Hint Extern 1 myType =>
+  unshelve notypeclasses refine (barToqux _ _).1 : typeclass_instances.
+
+Hint Extern 0 { x : _ & _ } =>
+  unshelve notypeclasses refine (existT _ _ _) : typeclass_instances.
+
+Unset Typeclasses Debug.
+
+Definition trivial a (H : Foo a) : {b : myType & Qux b}. 
+Proof.
+  Time typeclasses eauto 10 with typeclass_instances.
+  Undo. Set Typeclasses Iterative Deepening.
+  (* Much faster in iteratove deepening mode *)
+  Time typeclasses eauto with typeclass_instances.
+Defined.
+
+End NTabareauClasses.
+
+
 Require Import List.
 
 Parameter in_list : list (nat * nat) -> nat -> Prop.
@@ -38,23 +216,6 @@ 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 :
- (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 *)
+  intros.
+  eauto with essai.
 Qed.
diff --git a/test-suite/success/eqdecide.v b/test-suite/success/eqdecide.v
index 1f6af0dc4..724e2998e 100644
--- a/test-suite/success/eqdecide.v
+++ b/test-suite/success/eqdecide.v
@@ -14,6 +14,18 @@ Lemma lem1 : forall x y : T, {x = y} + {x <> y}.
  decide equality.
 Qed.
 
+Lemma lem1' : forall x y : T, x = y \/ x <> y.
+ decide equality.
+Qed.
+
+Lemma lem1'' : forall x y : T, {x <> y} + {x = y}.
+ decide equality.
+Qed.
+
+Lemma lem1''' : forall x y : T, x <> y \/ x = y.
+ decide equality.
+Qed.
+
 Lemma lem2 : forall x y : T, {x = y} + {x <> y}.
 intros x y.
  decide equality.
diff --git a/test-suite/success/goal_selector.v b/test-suite/success/goal_selector.v
new file mode 100644
index 000000000..868140517
--- /dev/null
+++ b/test-suite/success/goal_selector.v
@@ -0,0 +1,55 @@
+Inductive two : bool -> Prop :=
+| Zero : two false
+| One : two true.
+
+Ltac dup :=
+  let H := fresh in assert (forall (P : Prop), P -> P -> P) as H by (intros; trivial);
+  apply H; clear H.
+
+Lemma transform : two false <-> two true.
+Proof. split; intros _; constructor. Qed.
+
+Goal two false /\ two true /\ two false /\ two true /\ two true /\ two true.
+Proof.
+  do 2 dup.
+  - repeat split.
+    2, 4-99, 100-3:idtac.
+    2-5:exact One.
+    par:exact Zero.
+  - repeat split.
+    3-6:swap 1 4.
+    1-5:swap 1 5.
+    0-4:exact One.
+    all:exact Zero.
+  - repeat split.
+    1, 3:exact Zero.
+    1, 2, 3, 4: exact One.
+  - repeat split.
+    all:apply transform.
+    2, 4, 6:apply transform.
+    all:apply transform.
+    1-5:apply transform.
+    1-6:exact One.
+Qed.
+
+Goal True -> True.
+Proof.
+  intros y; only 1-2 : repeat idtac.
+  1-1:match goal with y : _ |- _ => let x := y in idtac x end.
+  Fail 1-1:let x := y in idtac x.
+  1:let x := y in idtac x.
+  exact I.
+Qed.
+
+Goal True /\ (True /\ True).
+Proof.
+  dup.
+  - split; only 2: (split; exact I).
+    exact I.
+  - split; only 2: split; exact I.
+Qed.
+
+Goal True -> exists (x : Prop), x.
+Proof.
+  intro H; eexists ?[x]; only [x]: exact True. 1: assumption.
+Qed.
diff --git a/test-suite/success/ltacprof.v b/test-suite/success/ltacprof.v
new file mode 100644
index 000000000..d5552695c
--- /dev/null
+++ b/test-suite/success/ltacprof.v
@@ -0,0 +1,8 @@
+(** Some LtacProf tests *)
+
+Set Ltac Profiling.
+Ltac multi := (idtac + idtac).
+Goal True.
+  try (multi; fail). (* Used to result in: Anomaly: Uncaught exception Failure("hd"). Please report. *)
+Admitted.
+Show Ltac Profile.
diff --git a/test-suite/success/onlyprinting.v b/test-suite/success/onlyprinting.v
new file mode 100644
index 000000000..91a628d79
--- /dev/null
+++ b/test-suite/success/onlyprinting.v
@@ -0,0 +1,7 @@
+Notation "x ++ y" := (plus x y) (only printing).
+
+Fail Check 0 ++ 0.
+
+Notation "x + y" := (max x y) (only printing).
+
+Check (eq_refl : 42 + 18 = 60).
diff --git a/test-suite/success/par_abstract.v b/test-suite/success/par_abstract.v
new file mode 100644
index 000000000..7f6f9d627
--- /dev/null
+++ b/test-suite/success/par_abstract.v
@@ -0,0 +1,25 @@
+Axiom T : Type.
+
+Lemma foo : True * Type.
+Proof.
+  split.
+  par: abstract (exact I || exact T).
+Defined.
+
+(* Yes, these names are generated hence
+   the test is fragile.  I want to assert
+   that abstract was correctly handled
+   by par: *)
+Check foo_subproof.
+Check foo_subproof0.
+Check (refl_equal _ :
+  foo =
+  pair foo_subproof foo_subproof0).
+
+Lemma bar : True * Type.
+Proof.
+  split.
+  par: (exact I || exact T).
+Defined.
+Check (refl_equal _ :
+  bar = pair I T).
diff --git a/test-suite/success/paralleltac.v b/test-suite/success/paralleltac.v
index 94ff96ef8..d25fd32a1 100644
--- a/test-suite/success/paralleltac.v
+++ b/test-suite/success/paralleltac.v
@@ -1,3 +1,17 @@
+Lemma test_nofail_like_all1 :
+  True /\ False.
+Proof.
+split.
+all: trivial.
+Admitted.
+
+Lemma test_nofail_like_all2 :
+  True /\ False.
+Proof.
+split.
+par: trivial.
+Admitted.
+
 Fixpoint fib n := match n with
   | O => 1
   | S m => match m with
@@ -19,28 +33,28 @@ Lemma test_old x : P (S x) /\ P (S x) /\ P (S x) /\ P (S x).
 Proof.
 repeat split.
 idtac "T1: linear".
-Time all: solve_P.
+Time all: solve [solve_P].
 Qed.
 
 Lemma test_ok x : P (S x) /\ P (S x) /\ P (S x) /\ P (S x).
 Proof.
 repeat split.
 idtac "T2: parallel".
-Time par: solve_P.
+Time par: solve [solve_P].
 Qed.
 
 Lemma test_fail x : P (S x) /\ P x /\ P (S x) /\ P (S x).
 Proof.
 repeat split.
 idtac "T3: linear failure".
-Fail Time all: solve_P.
-all: apply (P_triv Type).
+Fail Time all: solve solve_P.
+all: solve [apply (P_triv Type)].
 Qed.
 
 Lemma test_fail2 x : P (S x) /\ P x /\ P (S x) /\ P (S x).
 Proof.
 repeat split.
 idtac "T4: parallel failure".
-Fail Time par: solve_P.
-all: apply (P_triv Type).
+Fail Time par: solve [solve_P].
+all: solve [apply (P_triv Type)].
 Qed.
diff --git a/test-suite/success/primitiveproj.v b/test-suite/success/primitiveproj.v
index b5e6ccd61..2fa770494 100644
--- a/test-suite/success/primitiveproj.v
+++ b/test-suite/success/primitiveproj.v
@@ -47,7 +47,9 @@ Check _.(next) : option Y.
 Lemma eta_ind (y : Y) : y = Build_Y y.(next).
 Proof. Fail reflexivity. Abort.
 
+Inductive Fdef := { Fa : nat ; Fb := Fa; Fc : Fdef }.
 
+Fail Scheme Fdef_rec := Induction for Fdef Sort Prop.
 
 (* 
   Rules for parsing and printing of primitive projections and their eta expansions.
diff --git a/test-suite/success/programequality.v b/test-suite/success/programequality.v
new file mode 100644
index 000000000..414c572f8
--- /dev/null
+++ b/test-suite/success/programequality.v
@@ -0,0 +1,13 @@
+Require Import Program.
+
+Axiom t : nat -> Set.
+
+Goal forall (x y : nat) (e : x = y) (e' : x = y) (P : t y -> x = y -> Type)
+       (a : t x),
+    P (eq_rect _ _ a _ e) e'.
+Proof.
+  intros.
+  pi_eq_proofs. clear e.
+  destruct e'. simpl.
+  change (P a eq_refl).
+Abort.
\ No newline at end of file
diff --git a/test-suite/success/simpl_tuning.v b/test-suite/success/simpl_tuning.v
index d4191b939..2728672f3 100644
--- a/test-suite/success/simpl_tuning.v
+++ b/test-suite/success/simpl_tuning.v
@@ -106,7 +106,7 @@ match goal with |- (f (g x1), h x2) = (f (g x1), h x2) => idtac end.
 Abort. 
 
 Definition volatile := fun x : nat => x.
-Arguments volatile /.
+Arguments volatile / _.
 
 Lemma foo : volatile = volatile.
 simpl.
diff --git a/test-suite/success/specialize.v b/test-suite/success/specialize.v
index 3faa1ca43..fba05cd90 100644
--- a/test-suite/success/specialize.v
+++ b/test-suite/success/specialize.v
@@ -64,3 +64,11 @@ assert (H:=H I).
 match goal with H:_ |- _ => clear H end.
 match goal with H:_ |- _ => exact H end.
 Qed.
+
+(* Test specialize as *)
+
+Goal (forall x, x=0) -> 1=0.
+intros.
+specialize (H 1) as ->.
+reflexivity.
+Qed.
diff --git a/test-suite/success/ssrpattern.v b/test-suite/success/ssrpattern.v
new file mode 100644
index 000000000..96f0bbac9
--- /dev/null
+++ b/test-suite/success/ssrpattern.v
@@ -0,0 +1,22 @@
+Require Import ssrmatching.
+
+(*Set Debug SsrMatching.*)
+
+Tactic Notation "at" "[" ssrpatternarg(pat) "]" tactic(t) :=
+  let name := fresh in
+  let def_name := fresh in
+  ssrpattern pat;
+  intro name;
+  pose proof (refl_equal name) as def_name;
+  unfold name at 1 in def_name;
+  t def_name;
+  [ rewrite <- def_name | idtac.. ];
+  clear name def_name.
+
+Lemma test (H : True -> True -> 3 = 7) : 28 = 3 * 4.
+Proof.
+at [ X in X * 4 ] ltac:(fun place => rewrite -> H in place).
+- reflexivity.
+- trivial.
+- trivial.
+Qed.
diff --git a/test-suite/success/subst.v b/test-suite/success/subst.v
index 8336f6a80..25ee81b58 100644
--- a/test-suite/success/subst.v
+++ b/test-suite/success/subst.v
@@ -23,3 +23,20 @@ subst.
 change (y = S (S y)) in H0.
 change (S y = y).
 Abort.
+
+(* A bug revealed by OCaml 4.03 warnings *)
+(* fixes in 4e3d464 and 89ec88f for v8.5, 4e3d4646 and 89ec88f1e for v8.6 *)
+Goal forall y, let x:=0 in y=x -> y=y.
+intros * H;
+(* This worked as expected *)
+subst.
+Fail clear H.
+Abort.
+
+Goal forall y, let x:=0 in x=y -> y=y.
+intros * H;
+(* Before the fix, this unfolded x instead of 
+   substituting y and erasing H *)
+subst.
+Fail clear H.
+Abort.
diff --git a/test-suite/success/vm_univ_poly.v b/test-suite/success/vm_univ_poly.v
index 58fa39743..62df96c0b 100644
--- a/test-suite/success/vm_univ_poly.v
+++ b/test-suite/success/vm_univ_poly.v
@@ -38,8 +38,8 @@ Definition _4 : sumbool_copy x = x :=
 
 (* Polymorphic Inductive Types *)
 Polymorphic Inductive poption@{i} (T : Type@{i}) : Type@{i} :=
-| PSome : T -> poption@{i} T
-| PNone : poption@{i} T.
+| PSome : T -> poption T
+| PNone : poption T.
 
 Polymorphic Definition poption_default@{i} {T : Type@{i}} (p : poption@{i} T) (x : T) : T :=
   match p with
@@ -49,7 +49,7 @@ Polymorphic Definition poption_default@{i} {T : Type@{i}} (p : poption@{i} T) (x
 
 Polymorphic Inductive plist@{i} (T : Type@{i}) : Type@{i} :=
 | pnil
-| pcons : T -> plist@{i} T -> plist@{i} T.
+| pcons : T -> plist T -> plist T.
 
 Arguments pnil {_}.
 Arguments pcons {_} _ _.
@@ -59,7 +59,7 @@ Polymorphic Definition pmap@{i j}
   fix pmap (ls : plist@{i} T) : plist@{j} U :=
     match ls with
     | @pnil _ => @pnil _
-    | @pcons _ l ls => @pcons@{j} U (f l) (pmap@{i j} ls)
+    | @pcons _ l ls => @pcons@{j} U (f l) (pmap ls)
     end.
 
 Universe Ubool.
@@ -75,7 +75,7 @@ Eval vm_compute in pmap (fun x => x -> Type) (pcons tbool (pcons (plist tbool) p
 
 Polymorphic Inductive Tree@{i} (T : Type@{i}) : Type@{i} :=
 | Empty
-| Branch : plist@{i} (Tree@{i} T) -> Tree@{i} T.
+| Branch : plist@{i} (Tree T) -> Tree T.
 
 Polymorphic Definition pfold@{i u}
             {T : Type@{i}} {U : Type@{u}} (f : T -> U -> U) :=
@@ -111,7 +111,7 @@ Polymorphic Fixpoint repeat@{i} {T : Type@{i}} (n : nat@{i}) (v : T) : plist@{i}
 Polymorphic Fixpoint big_tree@{i} (n : nat@{i}) : Tree@{i} nat@{i} :=
   match n with
   | O => @Empty nat@{i}
-  | S n' => Branch@{i} nat@{i} (repeat@{i} n' (big_tree@{i} n'))
+  | S n' => Branch@{i} nat@{i} (repeat@{i} n' (big_tree n'))
   end.
 
 Eval compute in height (big_tree (S (S (S O)))).
diff --git a/theories/Arith/Between.v b/theories/Arith/Between.v
index f998e8619..58d3a2b38 100644
--- a/theories/Arith/Between.v
+++ b/theories/Arith/Between.v
@@ -20,20 +20,20 @@ Section Between.
     | bet_emp : between k k
     | bet_S : forall l, between k l -> P l -> between k (S l).
 
-  Hint Constructors between: arith v62.
+  Hint Constructors between: arith.
 
   Lemma bet_eq : forall k l, l = k -> between k l.
   Proof.
     induction 1; auto with arith.
   Qed.
 
-  Hint Resolve bet_eq: arith v62.
+  Hint Resolve bet_eq: arith.
 
   Lemma between_le : forall k l, between k l -> k <= l.
   Proof.
     induction 1; auto with arith.
   Qed.
-  Hint Immediate between_le: arith v62.
+  Hint Immediate between_le: arith.
 
   Lemma between_Sk_l : forall k l, between k l -> S k <= l -> between (S k) l.
   Proof.
@@ -41,7 +41,7 @@ Section Between.
     intros; absurd (S k <= k); auto with arith.
     destruct H; auto with arith.
   Qed.
-  Hint Resolve between_Sk_l: arith v62.
+  Hint Resolve between_Sk_l: arith.
 
   Lemma between_restr :
     forall k l (m:nat), k <= l -> l <= m -> between k m -> between l m.
@@ -53,7 +53,7 @@ Section Between.
     | exists_S : forall l, exists_between k l -> exists_between k (S l)
     | exists_le : forall l, k <= l -> Q l -> exists_between k (S l).
 
-  Hint Constructors exists_between: arith v62.
+  Hint Constructors exists_between: arith.
 
   Lemma exists_le_S : forall k l, exists_between k l -> S k <= l.
   Proof.
@@ -62,13 +62,13 @@ Section Between.
 
   Lemma exists_lt : forall k l, exists_between k l -> k < l.
   Proof exists_le_S.
-  Hint Immediate exists_le_S exists_lt: arith v62.
+  Hint Immediate exists_le_S exists_lt: arith.
 
   Lemma exists_S_le : forall k l, exists_between k (S l) -> k <= l.
   Proof.
     intros; apply le_S_n; auto with arith.
   Qed.
-  Hint Immediate exists_S_le: arith v62.
+  Hint Immediate exists_S_le: arith.
 
   Definition in_int p q r := p <= r /\ r < q.
 
@@ -76,7 +76,7 @@ Section Between.
   Proof.
     red; auto with arith.
   Qed.
-  Hint Resolve in_int_intro: arith v62.
+  Hint Resolve in_int_intro: arith.
 
   Lemma in_int_lt : forall p q r, in_int p q r -> p < q.
   Proof.
@@ -95,13 +95,13 @@ Section Between.
   Proof.
     induction 1; auto with arith.
   Qed.
-  Hint Resolve in_int_S: arith v62.
+  Hint Resolve in_int_S: arith.
 
   Lemma in_int_Sp_q : forall p q r, in_int (S p) q r -> in_int p q r.
   Proof.
     induction 1; auto with arith.
   Qed.
-  Hint Immediate in_int_Sp_q: arith v62.
+  Hint Immediate in_int_Sp_q: arith.
 
   Lemma between_in_int :
     forall k l, between k l -> forall r, in_int k l r -> P r.
@@ -183,5 +183,5 @@ Section Between.
 End Between.
 
 Hint Resolve nth_O bet_S bet_emp bet_eq between_Sk_l exists_S exists_le
-  in_int_S in_int_intro: arith v62.
-Hint Immediate in_int_Sp_q exists_le_S exists_S_le: arith v62.
+  in_int_S in_int_intro: arith.
+Hint Immediate in_int_Sp_q exists_le_S exists_S_le: arith.
diff --git a/theories/Arith/EqNat.v b/theories/Arith/EqNat.v
index 206fc0ab5..f998c19fc 100644
--- a/theories/Arith/EqNat.v
+++ b/theories/Arith/EqNat.v
@@ -25,7 +25,7 @@ Theorem eq_nat_refl n : eq_nat n n.
 Proof.
   induction n; simpl; auto.
 Qed.
-Hint Resolve eq_nat_refl: arith v62.
+Hint Resolve eq_nat_refl: arith.
 
 (** [eq] restricted to [nat] and [eq_nat] are equivalent *)
 
@@ -46,7 +46,7 @@ Proof.
  apply eq_nat_is_eq.
 Qed.
 
-Hint Immediate eq_eq_nat eq_nat_eq: arith v62.
+Hint Immediate eq_eq_nat eq_nat_eq: arith.
 
 Theorem eq_nat_elim :
   forall n (P:nat -> Prop), P n -> forall m, eq_nat n m -> P m.
diff --git a/theories/Arith/Gt.v b/theories/Arith/Gt.v
index dfd576946..67c94fdf6 100644
--- a/theories/Arith/Gt.v
+++ b/theories/Arith/Gt.v
@@ -133,14 +133,14 @@ Qed.
 
 (** * Hints *)
 
-Hint Resolve gt_Sn_O gt_Sn_n gt_n_S : arith v62.
-Hint Immediate gt_S_n gt_pred : arith v62.
-Hint Resolve gt_irrefl gt_asym : arith v62.
-Hint Resolve le_not_gt gt_not_le : arith v62.
-Hint Immediate le_S_gt gt_S_le : arith v62.
-Hint Resolve gt_le_S le_gt_S : arith v62.
-Hint Resolve gt_trans_S le_gt_trans gt_le_trans: arith v62.
-Hint Resolve plus_gt_compat_l: arith v62.
+Hint Resolve gt_Sn_O gt_Sn_n gt_n_S : arith.
+Hint Immediate gt_S_n gt_pred : arith.
+Hint Resolve gt_irrefl gt_asym : arith.
+Hint Resolve le_not_gt gt_not_le : arith.
+Hint Immediate le_S_gt gt_S_le : arith.
+Hint Resolve gt_le_S le_gt_S : arith.
+Hint Resolve gt_trans_S le_gt_trans gt_le_trans: arith.
+Hint Resolve plus_gt_compat_l: arith.
 
 (* begin hide *)
 Notation gt_O_eq := gt_0_eq (only parsing).
diff --git a/theories/Arith/Le.v b/theories/Arith/Le.v
index ceb91187b..0fbcec572 100644
--- a/theories/Arith/Le.v
+++ b/theories/Arith/Le.v
@@ -30,8 +30,8 @@ Notation le_refl := Nat.le_refl (compat "8.4").
 Notation le_trans := Nat.le_trans (compat "8.4").
 Notation le_antisym := Nat.le_antisymm (compat "8.4").
 
-Hint Resolve le_trans: arith v62.
-Hint Immediate le_antisym: arith v62.
+Hint Resolve le_trans: arith.
+Hint Immediate le_antisym: arith.
 
 (** * Properties of [le] w.r.t 0 *)
 
@@ -59,16 +59,16 @@ Notation le_Sn_n := Nat.nle_succ_diag_l (compat "8.4"). (* ~ S n <= n *)
 Theorem le_Sn_le : forall n m, S n <= m -> n <= m.
 Proof Nat.lt_le_incl.
 
-Hint Resolve le_0_n le_Sn_0: arith v62.
-Hint Resolve le_n_S le_n_Sn le_Sn_n : arith v62.
-Hint Immediate le_n_0_eq le_Sn_le le_S_n : arith v62.
+Hint Resolve le_0_n le_Sn_0: arith.
+Hint Resolve le_n_S le_n_Sn le_Sn_n : arith.
+Hint Immediate le_n_0_eq le_Sn_le le_S_n : arith.
 
 (** * Properties of [le] w.r.t predecessor *)
 
 Notation le_pred_n := Nat.le_pred_l (compat "8.4"). (* pred n <= n *)
 Notation le_pred := Nat.pred_le_mono (compat "8.4"). (* n<=m -> pred n <= pred m *)
 
-Hint Resolve le_pred_n: arith v62.
+Hint Resolve le_pred_n: arith.
 
 (** * A different elimination principle for the order on natural numbers *)
 
diff --git a/theories/Arith/Lt.v b/theories/Arith/Lt.v
index f824ee6fb..bfc2b91a9 100644
--- a/theories/Arith/Lt.v
+++ b/theories/Arith/Lt.v
@@ -25,7 +25,7 @@ Local Open Scope nat_scope.
 
 Notation lt_irrefl := Nat.lt_irrefl (compat "8.4"). (* ~ x < x *)
 
-Hint Resolve lt_irrefl: arith v62.
+Hint Resolve lt_irrefl: arith.
 
 (** * Relationship between [le] and [lt] *)
 
@@ -44,9 +44,9 @@ Proof.
  apply Nat.lt_succ_r.
 Qed.
 
-Hint Immediate lt_le_S: arith v62.
-Hint Immediate lt_n_Sm_le: arith v62.
-Hint Immediate le_lt_n_Sm: arith v62.
+Hint Immediate lt_le_S: arith.
+Hint Immediate lt_n_Sm_le: arith.
+Hint Immediate le_lt_n_Sm: arith.
 
 Theorem le_not_lt n m : n <= m -> ~ m < n.
 Proof.
@@ -58,7 +58,7 @@ Proof.
  apply Nat.lt_nge.
 Qed.
 
-Hint Immediate le_not_lt lt_not_le: arith v62.
+Hint Immediate le_not_lt lt_not_le: arith.
 
 (** * Asymmetry *)
 
@@ -79,8 +79,8 @@ Proof.
  intros. now apply Nat.neq_sym, Nat.neq_0_lt_0.
 Qed.
 
-Hint Resolve lt_0_Sn lt_n_0 : arith v62.
-Hint Immediate neq_0_lt lt_0_neq: arith v62.
+Hint Resolve lt_0_Sn lt_n_0 : arith.
+Hint Immediate neq_0_lt lt_0_neq: arith.
 
 (** * Order and successor *)
 
@@ -97,8 +97,8 @@ Proof.
  apply Nat.succ_lt_mono.
 Qed.
 
-Hint Resolve lt_n_Sn lt_S lt_n_S : arith v62.
-Hint Immediate lt_S_n : arith v62.
+Hint Resolve lt_n_Sn lt_S lt_n_S : arith.
+Hint Immediate lt_S_n : arith.
 
 (** * Predecessor *)
 
@@ -117,8 +117,8 @@ Proof.
  intros. now apply Nat.lt_pred_l, Nat.neq_0_lt_0.
 Qed.
 
-Hint Immediate lt_pred: arith v62.
-Hint Resolve lt_pred_n_n: arith v62.
+Hint Immediate lt_pred: arith.
+Hint Resolve lt_pred_n_n: arith.
 
 (** * Transitivity properties *)
 
@@ -126,7 +126,7 @@ Notation lt_trans := Nat.lt_trans (compat "8.4").
 Notation lt_le_trans := Nat.lt_le_trans (compat "8.4").
 Notation le_lt_trans := Nat.le_lt_trans (compat "8.4").
 
-Hint Resolve lt_trans lt_le_trans le_lt_trans: arith v62.
+Hint Resolve lt_trans lt_le_trans le_lt_trans: arith.
 
 (** * Large = strict or equal *)
 
@@ -139,7 +139,7 @@ Qed.
 
 Notation lt_le_weak := Nat.lt_le_incl (compat "8.4").
 
-Hint Immediate lt_le_weak: arith v62.
+Hint Immediate lt_le_weak: arith.
 
 (** * Dichotomy *)
 
diff --git a/theories/Arith/Max.v b/theories/Arith/Max.v
index 65534b2e3..49152549a 100644
--- a/theories/Arith/Max.v
+++ b/theories/Arith/Max.v
@@ -42,7 +42,7 @@ Notation max_SS := Nat.succ_max_distr (only parsing).
 (* end hide *)
 
 Hint Resolve
- Nat.max_l Nat.max_r Nat.le_max_l Nat.le_max_r : arith v62.
+ Nat.max_l Nat.max_r Nat.le_max_l Nat.le_max_r : arith.
 
 Hint Resolve
- Nat.min_l Nat.min_r Nat.le_min_l Nat.le_min_r : arith v62.
+ Nat.min_l Nat.min_r Nat.le_min_l Nat.le_min_r : arith.
diff --git a/theories/Arith/Minus.v b/theories/Arith/Minus.v
index bc3a318cf..1fc8f7907 100644
--- a/theories/Arith/Minus.v
+++ b/theories/Arith/Minus.v
@@ -107,13 +107,13 @@ Qed.
 
 (** * Hints *)
 
-Hint Resolve minus_n_O: arith v62.
-Hint Resolve minus_Sn_m: arith v62.
-Hint Resolve minus_diag_reverse: arith v62.
-Hint Resolve minus_plus_simpl_l_reverse: arith v62.
-Hint Immediate plus_minus: arith v62.
-Hint Resolve minus_plus: arith v62.
-Hint Resolve le_plus_minus: arith v62.
-Hint Resolve le_plus_minus_r: arith v62.
-Hint Resolve lt_minus: arith v62.
-Hint Immediate lt_O_minus_lt: arith v62.
+Hint Resolve minus_n_O: arith.
+Hint Resolve minus_Sn_m: arith.
+Hint Resolve minus_diag_reverse: arith.
+Hint Resolve minus_plus_simpl_l_reverse: arith.
+Hint Immediate plus_minus: arith.
+Hint Resolve minus_plus: arith.
+Hint Resolve le_plus_minus: arith.
+Hint Resolve le_plus_minus_r: arith.
+Hint Resolve lt_minus: arith.
+Hint Immediate lt_O_minus_lt: arith.
diff --git a/theories/Arith/Mult.v b/theories/Arith/Mult.v
index 965812432..a173efc10 100644
--- a/theories/Arith/Mult.v
+++ b/theories/Arith/Mult.v
@@ -31,13 +31,13 @@ Notation mult_0_r := Nat.mul_0_r (compat "8.4"). (* n * 0 = 0 *)
 Notation mult_1_l := Nat.mul_1_l (compat "8.4"). (* 1 * n = n *)
 Notation mult_1_r := Nat.mul_1_r (compat "8.4"). (* n * 1 = n *)
 
-Hint Resolve mult_1_l mult_1_r: arith v62.
+Hint Resolve mult_1_l mult_1_r: arith.
 
 (** ** Commutativity *)
 
 Notation mult_comm := Nat.mul_comm (compat "8.4"). (* n * m = m * n *)
 
-Hint Resolve mult_comm: arith v62.
+Hint Resolve mult_comm: arith.
 
 (** ** Distributivity *)
 
@@ -53,9 +53,9 @@ Notation mult_minus_distr_r :=
 Notation mult_minus_distr_l :=
   Nat.mul_sub_distr_l (compat "8.4"). (* n*(m-p) = n*m - n*p *)
 
-Hint Resolve mult_plus_distr_r: arith v62.
-Hint Resolve mult_minus_distr_r: arith v62.
-Hint Resolve mult_minus_distr_l: arith v62.
+Hint Resolve mult_plus_distr_r: arith.
+Hint Resolve mult_minus_distr_r: arith.
+Hint Resolve mult_minus_distr_l: arith.
 
 (** ** Associativity *)
 
@@ -66,8 +66,8 @@ Proof.
  symmetry. apply Nat.mul_assoc.
 Qed.
 
-Hint Resolve mult_assoc_reverse: arith v62.
-Hint Resolve mult_assoc: arith v62.
+Hint Resolve mult_assoc_reverse: arith.
+Hint Resolve mult_assoc: arith.
 
 (** ** Inversion lemmas *)
 
@@ -92,7 +92,7 @@ Lemma mult_O_le n m : m = 0 \/ n <= m * n.
 Proof.
  destruct m; [left|right]; simpl; trivial using Nat.le_add_r.
 Qed.
-Hint Resolve mult_O_le: arith v62.
+Hint Resolve mult_O_le: arith.
 
 Lemma mult_le_compat_l n m p : n <= m -> p * n <= p * m.
 Proof.
diff --git a/theories/Arith/Peano_dec.v b/theories/Arith/Peano_dec.v
index 340a79689..f8020a50e 100644
--- a/theories/Arith/Peano_dec.v
+++ b/theories/Arith/Peano_dec.v
@@ -38,8 +38,7 @@ intros m n.
 generalize (eq_refl (S n)).
 generalize n at -1.
 induction (S n) as [|n0 IHn0]; try discriminate.
-clear n; intros n H; injection H; clear H; intro H.
-rewrite <- H; intros le_mn1 le_mn2; clear n H.
+clear n; intros n [= <-] le_mn1 le_mn2.
 pose (def_n2 := eq_refl n0); transitivity (eq_ind _ _ le_mn2 _ def_n2).
   2: reflexivity.
 generalize def_n2; revert le_mn1 le_mn2.
@@ -50,7 +49,7 @@ destruct le_mn1; intros le_mn2; destruct le_mn2.
   now destruct (Nat.nle_succ_diag_l _ le_mn0).
 + intros def_n0; generalize le_mn1; rewrite def_n0; intros le_mn0.
   now destruct (Nat.nle_succ_diag_l _ le_mn0).
-+ intros def_n0; injection def_n0; intros ->.
++ intros def_n0. injection def_n0 as ->.
   rewrite (UIP_nat _ _ def_n0 eq_refl); simpl.
   assert (H : le_mn1 = le_mn2).
     now apply IHn0.
diff --git a/theories/Arith/Plus.v b/theories/Arith/Plus.v
index 3b823da6f..600e5e518 100644
--- a/theories/Arith/Plus.v
+++ b/theories/Arith/Plus.v
@@ -177,12 +177,12 @@ Proof (succ_plus_discr n 3).
 
 (** * Compatibility Hints *)
 
-Hint Immediate plus_comm : arith v62.
-Hint Resolve plus_assoc plus_assoc_reverse : arith v62.
-Hint Resolve plus_le_compat_l plus_le_compat_r : arith v62.
-Hint Resolve le_plus_l le_plus_r le_plus_trans : arith v62.
-Hint Immediate lt_plus_trans : arith v62.
-Hint Resolve plus_lt_compat_l plus_lt_compat_r : arith v62.
+Hint Immediate plus_comm : arith.
+Hint Resolve plus_assoc plus_assoc_reverse : arith.
+Hint Resolve plus_le_compat_l plus_le_compat_r : arith.
+Hint Resolve le_plus_l le_plus_r le_plus_trans : arith.
+Hint Immediate lt_plus_trans : arith.
+Hint Resolve plus_lt_compat_l plus_lt_compat_r : arith.
 
 (** For compatibility, we "Require" the same files as before *)
 
diff --git a/theories/Bool/Bool.v b/theories/Bool/Bool.v
index 721ab6932..06096c66a 100644
--- a/theories/Bool/Bool.v
+++ b/theories/Bool/Bool.v
@@ -39,13 +39,13 @@ Lemma diff_true_false : true <> false.
 Proof.
   discriminate.
 Qed.
-Hint Resolve diff_true_false : bool v62.
+Hint Resolve diff_true_false : bool.
 
 Lemma diff_false_true : false <> true.
 Proof.
   discriminate.
 Qed.
-Hint Resolve diff_false_true : bool v62.
+Hint Resolve diff_false_true : bool.
 Hint Extern 1 (false <> true) => exact diff_false_true.
 
 Lemma eq_true_false_abs : forall b:bool, b = true -> b = false -> False.
@@ -82,7 +82,7 @@ Definition leb (b1 b2:bool) :=
     | true => b2 = true
     | false => True
   end.
-Hint Unfold leb: bool v62.
+Hint Unfold leb: bool.
 
 Lemma leb_implb : forall b1 b2, leb b1 b2 <-> implb b1 b2 = true.
 Proof.
@@ -242,14 +242,14 @@ Lemma orb_true_intro :
 Proof.
  intros; apply orb_true_iff; trivial.
 Qed.
-Hint Resolve orb_true_intro: bool v62.
+Hint Resolve orb_true_intro: bool.
 
 Lemma orb_false_intro :
   forall b1 b2:bool, b1 = false -> b2 = false -> b1 || b2 = false.
 Proof.
  intros. subst. reflexivity.
 Qed.
-Hint Resolve orb_false_intro: bool v62.
+Hint Resolve orb_false_intro: bool.
 
 Lemma orb_false_elim :
   forall b1 b2:bool, b1 || b2 = false -> b1 = false /\ b2 = false.
@@ -268,7 +268,7 @@ Lemma orb_true_r : forall b:bool, b || true = true.
 Proof.
   destr_bool.
 Qed.
-Hint Resolve orb_true_r: bool v62.
+Hint Resolve orb_true_r: bool.
 
 Lemma orb_true_l : forall b:bool, true || b = true.
 Proof.
@@ -284,13 +284,13 @@ Lemma orb_false_r : forall b:bool, b || false = b.
 Proof.
   destr_bool.
 Qed.
-Hint Resolve orb_false_r: bool v62.
+Hint Resolve orb_false_r: bool.
 
 Lemma orb_false_l : forall b:bool, false || b = b.
 Proof.
   destr_bool.
 Qed.
-Hint Resolve orb_false_l: bool v62.
+Hint Resolve orb_false_l: bool.
 
 Notation orb_b_false := orb_false_r (only parsing).
 Notation orb_false_b := orb_false_l (only parsing).
@@ -301,7 +301,7 @@ Lemma orb_negb_r : forall b:bool, b || negb b = true.
 Proof.
   destr_bool.
 Qed.
-Hint Resolve orb_negb_r: bool v62.
+Hint Resolve orb_negb_r: bool.
 
 Notation orb_neg_b := orb_negb_r (only parsing).
 
@@ -318,7 +318,7 @@ Lemma orb_assoc : forall b1 b2 b3:bool, b1 || (b2 || b3) = b1 || b2 || b3.
 Proof.
   destr_bool.
 Qed.
-Hint Resolve orb_comm orb_assoc: bool v62.
+Hint Resolve orb_comm orb_assoc: bool.
 
 (*******************************)
 (** * Properties of [andb]     *)
@@ -392,7 +392,7 @@ Lemma andb_false_elim :
 Proof.
   destruct b1; simpl; auto.
 Defined.
-Hint Resolve andb_false_elim: bool v62.
+Hint Resolve andb_false_elim: bool.
 
 (** Complementation *)
 
@@ -400,7 +400,7 @@ Lemma andb_negb_r : forall b:bool, b && negb b = false.
 Proof.
   destr_bool.
 Qed.
-Hint Resolve andb_negb_r: bool v62.
+Hint Resolve andb_negb_r: bool.
 
 Notation andb_neg_b := andb_negb_r (only parsing).
 
@@ -418,7 +418,7 @@ Proof.
   destr_bool.
 Qed.
 
-Hint Resolve andb_comm andb_assoc: bool v62.
+Hint Resolve andb_comm andb_assoc: bool.
 
 (*******************************************)
 (** * Properties mixing [andb] and [orb] *)
@@ -688,7 +688,7 @@ Lemma andb_prop_intro :
 Proof.
   destr_bool; tauto.
 Qed.
-Hint Resolve andb_prop_intro: bool v62.
+Hint Resolve andb_prop_intro: bool.
 
 Notation andb_true_intro2 :=
   (fun b1 b2 H1 H2 => andb_prop_intro b1 b2 (conj H1 H2))
@@ -699,7 +699,7 @@ Lemma andb_prop_elim :
 Proof.
   destr_bool; auto.
 Qed.
-Hint Resolve andb_prop_elim: bool v62.
+Hint Resolve andb_prop_elim: bool.
 
 Notation andb_prop2 := andb_prop_elim (only parsing).
 
diff --git a/theories/Bool/IfProp.v b/theories/Bool/IfProp.v
index 11f3d1d6f..4257b4bc1 100644
--- a/theories/Bool/IfProp.v
+++ b/theories/Bool/IfProp.v
@@ -12,7 +12,7 @@ Inductive IfProp (A B:Prop) : bool -> Prop :=
   | Iftrue : A -> IfProp A B true
   | Iffalse : B -> IfProp A B false.
 
-Hint Resolve Iftrue Iffalse: bool v62.
+Hint Resolve Iftrue Iffalse: bool.
 
 Lemma Iftrue_inv : forall (A B:Prop) (b:bool), IfProp A B b -> b = true -> A.
 destruct 1; intros; auto with bool.
diff --git a/theories/Classes/Equivalence.v b/theories/Classes/Equivalence.v
index c45889479..80b0b7e4c 100644
--- a/theories/Classes/Equivalence.v
+++ b/theories/Classes/Equivalence.v
@@ -49,11 +49,11 @@ Infix "=~=" := pequiv (at level 70, no associativity) : equiv_scope.
 
 (** Shortcuts to make proof search easier. *)
 
-Program Instance equiv_reflexive `(sa : Equivalence A) : Reflexive equiv.
+Program Instance equiv_reflexive `(sa : Equivalence A) : Reflexive equiv | 1.
 
-Program Instance equiv_symmetric `(sa : Equivalence A) : Symmetric equiv.
+Program Instance equiv_symmetric `(sa : Equivalence A) : Symmetric equiv | 1.
 
-Program Instance equiv_transitive `(sa : Equivalence A) : Transitive equiv.
+Program Instance equiv_transitive `(sa : Equivalence A) : Transitive equiv | 1.
 
   Next Obligation.
   Proof. intros A R sa x y z Hxy Hyz.
@@ -123,7 +123,7 @@ Section Respecting.
 
 End Respecting.
 
-(** The default equivalence on function spaces, with higher-priority than [eq]. *)
+(** The default equivalence on function spaces, with higher priority than [eq]. *)
 
 Instance pointwise_reflexive {A} `(reflb : Reflexive B eqB) :
   Reflexive (pointwise_relation A eqB) | 9.
diff --git a/theories/Classes/Morphisms.v b/theories/Classes/Morphisms.v
index 81b31d783..06511ace5 100644
--- a/theories/Classes/Morphisms.v
+++ b/theories/Classes/Morphisms.v
@@ -470,7 +470,7 @@ Ltac partial_application_tactic :=
     end
   in
   let rec do_partial H ar m := 
-    match ar with
+    lazymatch ar with
       | 0%nat => do_partial_apps H m ltac:(fail 1)
       | S ?n' =>
         match m with
@@ -483,7 +483,7 @@ Ltac partial_application_tactic :=
      let n := fresh in evar (n:nat) ;
      let v := eval compute in n in clear n ;
       let H := fresh in
-        assert(H:Params m' v) by typeclasses eauto ;
+        assert(H:Params m' v) by (subst m'; once typeclasses eauto) ;
           let v' := eval compute in v in subst m';
             (sk H v' || fail 1))
     || fk
diff --git a/theories/Classes/RelationPairs.v b/theories/Classes/RelationPairs.v
index cbde5f9ab..8d1c49822 100644
--- a/theories/Classes/RelationPairs.v
+++ b/theories/Classes/RelationPairs.v
@@ -43,6 +43,9 @@ Generalizable Variables A B RA RB Ri Ro f.
 Definition RelCompFun {A} {B : Type}(R:relation B)(f:A->B) : relation A :=
  fun a a' => R (f a) (f a').
 
+(** Instances on RelCompFun must match syntactically *)
+Typeclasses Opaque RelCompFun. 
+
 Infix "@@" := RelCompFun (at level 30, right associativity) : signature_scope.
 
 Notation "R @@1" := (R @@ Fst)%signature (at level 30) : signature_scope.
@@ -65,6 +68,8 @@ Instance snd_measure : @Measure (A * B) B Snd.
 Definition RelProd {A : Type} {B : Type} (RA:relation A)(RB:relation B) : relation (A*B) :=
  relation_conjunction (@RelCompFun (A * B) A RA fst) (RB @@2).
 
+Typeclasses Opaque RelProd.
+
 Infix "*" := RelProd : signature_scope.
 
 Section RelCompFun_Instances.
diff --git a/theories/Compat/Coq84.v b/theories/Compat/Coq84.v
index aa4411704..a3e23f91c 100644
--- a/theories/Compat/Coq84.v
+++ b/theories/Compat/Coq84.v
@@ -7,6 +7,10 @@
 (************************************************************************)
 
 (** Compatibility file for making Coq act similar to Coq v8.4 *)
+
+(** Any compatibility changes to make future versions of Coq behave like Coq 8.5 are likely needed to make them behave like Coq 8.4. *)
+Require Export Coq.Compat.Coq85.
+
 (** See https://coq.inria.fr/bugs/show_bug.cgi?id=4319 for updates *)
 (** This is required in Coq 8.5 to use the [omega] tactic; in Coq 8.4, it's automatically available.  But ZArith_base puts infix ~ at level 7, and we don't want that, so we don't [Import] it. *)
 Require Coq.omega.Omega.
@@ -21,6 +25,9 @@ Global Set Nonrecursive Elimination Schemes.
 (** See bug 3545 *)
 Global Set Universal Lemma Under Conjunction.
 
+(** Feature introduced in 8.5, disabled by default and configurable since 8.6. *)
+Global Unset Refolding Reduction.
+
 (** In 8.4, [constructor (tac)] allowed backtracking across the use of [constructor]; it has been subsumed by [constructor; tac]. *)
 Ltac constructor_84_n n := constructor n.
 Ltac constructor_84_tac tac := once (constructor; tac).
@@ -66,3 +73,7 @@ Coercion sigT_of_sig : sig >-> sigT.
 Coercion sig_of_sigT : sigT >-> sig.
 Coercion sigT2_of_sig2 : sig2 >-> sigT2.
 Coercion sig2_of_sigT2 : sigT2 >-> sig2.
+
+(** In 8.4, the statement of admitted lemmas did not depend on the section
+    variables. *)
+Unset Keep Admitted Variables.
diff --git a/theories/Compat/Coq85.v b/theories/Compat/Coq85.v
index af2e04f88..64ba6b1e3 100644
--- a/theories/Compat/Coq85.v
+++ b/theories/Compat/Coq85.v
@@ -8,9 +8,29 @@
 
 (** Compatibility file for making Coq act similar to Coq v8.5 *)
 
+(** Any compatibility changes to make future versions of Coq behave like Coq 8.6
+    are likely needed to make them behave like Coq 8.5. *)
+Require Export Coq.Compat.Coq86.
+
+(** We use some deprecated options in this file, so we disable the
+    corresponding warning, to silence the build of this file. *)
+Local Set Warnings "-deprecated-option".
+
 (* In 8.5, "intros [|]", taken e.g. on a goal "A\/B->C", does not
    behave as "intros [H|H]" but leave instead hypotheses quantified in
    the goal, here producing subgoals A->C and B->C. *)
 
-Unset Bracketing Last Introduction Pattern.
+Global Unset Bracketing Last Introduction Pattern.
+Global Unset Regular Subst Tactic.
+Global Unset Structural Injection.
+Global Unset Shrink Abstract.
+Global Unset Shrink Obligations.
+Global Set Refolding Reduction.
+
+(** The resolution algorithm for type classes has changed. *)
+Global Set Typeclasses Legacy Resolution.
+Global Set Typeclasses Limit Intros.
+Global Unset Typeclasses Filtered Unification.
 
+(** Allow silently letting unification constraints float after a "." *)
+Global Unset Solve Unification Constraints.
diff --git a/theories/Compat/Coq86.v b/theories/Compat/Coq86.v
new file mode 100644
index 000000000..6952fdf19
--- /dev/null
+++ b/theories/Compat/Coq86.v
@@ -0,0 +1,9 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+(** Compatibility file for making Coq act similar to Coq v8.6 *)
\ No newline at end of file
diff --git a/theories/Compat/vo.itarget b/theories/Compat/vo.itarget
index 43b197004..7ffb86ebb 100644
--- a/theories/Compat/vo.itarget
+++ b/theories/Compat/vo.itarget
@@ -1,3 +1,4 @@
 AdmitAxiom.vo
 Coq84.vo
 Coq85.vo
+Coq86.vo
diff --git a/theories/FSets/FMapFacts.v b/theories/FSets/FMapFacts.v
index eaeb2914b..3c5690a72 100644
--- a/theories/FSets/FMapFacts.v
+++ b/theories/FSets/FMapFacts.v
@@ -24,6 +24,8 @@ Hint Extern 1 (Equivalence _) => constructor; congruence.
 
 Module WFacts_fun (E:DecidableType)(Import M:WSfun E).
 
+Notation option_map := option_map (compat "8.4").
+
 Notation eq_dec := E.eq_dec.
 Definition eqb x y := if eq_dec x y then true else false.
 
@@ -1986,7 +1988,7 @@ Module OrdProperties (M:S).
   simpl; intros; try discriminate.
   intros.
   destruct a; destruct l; simpl in *.
-  injection H; clear H; intros; subst.
+  injection H as -> ->.
   inversion_clear H1.
   red in H; simpl in *; intuition.
   elim H0; eauto.
@@ -2050,10 +2052,10 @@ Module OrdProperties (M:S).
   generalize (elements_3 m).
   destruct (elements m).
   try discriminate.
-  destruct p; injection H; intros; subst.
-  inversion_clear H1.
+  destruct p; injection H as -> ->; intros H4.
+  inversion_clear H1 as [? ? H2|? ? H2].
   red in H2; destruct H2; simpl in *; ME.order.
-  inversion_clear H4.
+  inversion_clear H4. rename H1 into H3.
   rewrite (@InfA_alt _ eqke) in H3; eauto with *.
   apply (H3 (y,x0)); auto.
   Qed.
diff --git a/theories/FSets/FMapList.v b/theories/FSets/FMapList.v
index 13cb559b9..5acdb7eb7 100644
--- a/theories/FSets/FMapList.v
+++ b/theories/FSets/FMapList.v
@@ -8,7 +8,7 @@
 
 (** * Finite map library *)
 
-(** This file proposes an implementation of the non-dependant interface
+(** This file proposes an implementation of the non-dependent interface
  [FMapInterface.S] using lists of pairs ordered (increasing) with respect to
  left projection. *)
 
diff --git a/theories/FSets/FMapPositive.v b/theories/FSets/FMapPositive.v
index 9e59f0c50..b1c0fdaa2 100644
--- a/theories/FSets/FMapPositive.v
+++ b/theories/FSets/FMapPositive.v
@@ -274,8 +274,8 @@ Module PositiveMap <: S with Module E:=PositiveOrderedTypeBits.
         rewrite append_assoc_1; apply in_or_app; right; apply in_cons;
           apply IHm2; auto.
         rewrite append_assoc_0; apply in_or_app; left; apply IHm1; auto.
-        rewrite append_neutral_r; apply in_or_app; injection H;
-          intro EQ; rewrite EQ; right; apply in_eq.
+        rewrite append_neutral_r; apply in_or_app; injection H as ->;
+          right; apply in_eq.
         rewrite append_assoc_1; apply in_or_app; right; apply IHm2; auto.
         rewrite append_assoc_0; apply in_or_app; left; apply IHm1; auto.
         congruence.
@@ -315,7 +315,7 @@ Module PositiveMap <: S with Module E:=PositiveOrderedTypeBits.
          apply in_or_app.
         left; apply IHm1; auto.
         right; destruct (in_inv H0).
-         injection H1; intros Eq1 Eq2; rewrite Eq1; rewrite Eq2; apply in_eq.
+         injection H1 as -> ->; apply in_eq.
          apply in_cons; apply IHm2; auto.
         left; apply IHm1; auto.
         right; apply IHm2; auto.
@@ -346,7 +346,7 @@ Module PositiveMap <: S with Module E:=PositiveOrderedTypeBits.
          apply in_or_app.
         left; apply IHm1; auto.
         right; destruct (in_inv H0).
-         injection H1; intros Eq1 Eq2; rewrite Eq1; rewrite Eq2; apply in_eq.
+         injection H1 as -> ->; apply in_eq.
          apply in_cons; apply IHm2; auto.
         left; apply IHm1; auto.
         right; apply IHm2; auto.
@@ -689,7 +689,7 @@ Module PositiveMap <: S with Module E:=PositiveOrderedTypeBits.
   destruct y2; destruct y0; compute in Hy2; destruct Hy2; subst.
   red; red; simpl.
   destruct H0.
-  injection H0; clear H0; intros _ H0; subst.
+  injection H0 as H0 _; subst.
   eapply xelements_bits_lt_1; eauto.
   apply E.bits_lt_trans with p.
   eapply xelements_bits_lt_1; eauto.
diff --git a/theories/FSets/FMapWeakList.v b/theories/FSets/FMapWeakList.v
index 0f11dd7a5..130cbee87 100644
--- a/theories/FSets/FMapWeakList.v
+++ b/theories/FSets/FMapWeakList.v
@@ -8,7 +8,7 @@
 
 (** * Finite map library *)
 
-(** This file proposes an implementation of the non-dependant interface
+(** This file proposes an implementation of the non-dependent interface
  [FMapInterface.WS] using lists of pairs, unordered but without redundancy. *)
 
 Require Import FMapInterface.
diff --git a/theories/FSets/FSetDecide.v b/theories/FSets/FSetDecide.v
index ad067eb3d..1db6a71e8 100644
--- a/theories/FSets/FSetDecide.v
+++ b/theories/FSets/FSetDecide.v
@@ -357,17 +357,8 @@ the above form:
         | _ => idtac
       end.
 
-    (** [if t then t1 else t2] executes [t] and, if it does not
-        fail, then [t1] will be applied to all subgoals
-        produced.  If [t] fails, then [t2] is executed. *)
-    Tactic Notation
-      "if" tactic(t)
-      "then" tactic(t1)
-      "else" tactic(t2) :=
-      first [ t; first [ t1 | fail 2 ] | t2 ].
-
     Ltac abstract_term t :=
-      if (is_var t) then fail "no need to abstract a variable"
+      tryif (is_var t) then fail "no need to abstract a variable"
       else (let x := fresh "x" in set (x := t) in *; try clearbody x).
 
     Ltac abstract_elements :=
@@ -478,11 +469,11 @@ the above form:
       repeat (
         match goal with
         | H : context [ @Logic.eq ?T ?x ?y ] |- _ =>
-          if (change T with E.t in H) then fail
-          else if (change T with t in H) then fail
+          tryif (change T with E.t in H) then fail
+          else tryif (change T with t in H) then fail
           else clear H
         | H : ?P |- _ =>
-          if prop (FSet_Prop P) holds by
+          tryif prop (FSet_Prop P) holds by
             (auto 100 with FSet_Prop)
           then fail
           else clear H
@@ -747,7 +738,7 @@ the above form:
     | H: (In ?x ?r) -> False |- (E.eq ?y ?x) -> False =>
       contradict H; fsetdec_body
     | H: ?P -> False |- ?Q -> False =>
-      if prop (FSet_elt_Prop P) holds by
+      tryif prop (FSet_elt_Prop P) holds by
         (auto 100 with FSet_Prop)
       then (contradict H; fsetdec_body)
       else fsetdec_body
diff --git a/theories/FSets/FSetList.v b/theories/FSets/FSetList.v
index 1f36306c3..9c3ec71ae 100644
--- a/theories/FSets/FSetList.v
+++ b/theories/FSets/FSetList.v
@@ -8,7 +8,7 @@
 
 (** * Finite sets library *)
 
-(** This file proposes an implementation of the non-dependant
+(** This file proposes an implementation of the non-dependent
     interface [FSetInterface.S] using strictly ordered list. *)
 
 Require Export FSetInterface.
diff --git a/theories/FSets/FSetPositive.v b/theories/FSets/FSetPositive.v
index 7398c6d65..507f1cda6 100644
--- a/theories/FSets/FSetPositive.v
+++ b/theories/FSets/FSetPositive.v
@@ -1007,10 +1007,10 @@ Module PositiveSet <: S with Module E:=PositiveOrderedTypeBits.
       destruct o.
         intros x H. injection H; intros; subst. reflexivity.
         revert IHl. case choose.
-          intros p Hp x H. injection H; intros; subst; clear H. apply Hp.
+          intros p Hp x H. injection H as <-. apply Hp.
            reflexivity.
           intros _ x. revert IHr. case choose.
-            intros p Hp H. injection H; intros; subst; clear H. apply Hp.
+            intros p Hp H. injection H as <-. apply Hp.
             reflexivity.
             intros. discriminate.
   Qed.
@@ -1066,11 +1066,11 @@ Module PositiveSet <: S with Module E:=PositiveOrderedTypeBits.
    induction s as [| l IHl o r IHr]; simpl.
      intros. discriminate.
      intros x. destruct (min_elt l); intros.
-       injection H. intros <-. apply IHl. reflexivity.
+       injection H as <-. apply IHl. reflexivity.
        destruct o; simpl.
-         injection H. intros <-. reflexivity.
+         injection H as <-. reflexivity.
          destruct (min_elt r); simpl in *.
-           injection H. intros <-. apply IHr. reflexivity.
+           injection H as <-. apply IHr. reflexivity.
            discriminate.
   Qed.
 
@@ -1094,15 +1094,15 @@ Module PositiveSet <: S with Module E:=PositiveOrderedTypeBits.
     induction s as [|l IHl o r IHr]; intros x y H H'.
       discriminate.
       simpl in H. case_eq (min_elt l).
-        intros p Hp. rewrite Hp in H. injection H; intros <-.
+        intros p Hp. rewrite Hp in H. injection H as <-.
         destruct y as [z|z|]; simpl; intro; trivial. apply (IHl p z); trivial.
         intro Hp; rewrite Hp in H. apply min_elt_3 in Hp.
         destruct o.
-          injection H. intros <- Hl. clear H.
+          injection H as <-. intros Hl.
           destruct y as [z|z|]; simpl; trivial. elim (Hp _ H').
 
           destruct (min_elt r).
-            injection H. intros <-. clear H.
+            injection H as <-.
             destruct y as [z|z|].
               apply (IHr e z); trivial.
               elim (Hp _ H').
@@ -1119,11 +1119,11 @@ Module PositiveSet <: S with Module E:=PositiveOrderedTypeBits.
    induction s as [| l IHl o r IHr]; simpl.
      intros. discriminate.
      intros x. destruct (max_elt r); intros.
-       injection H. intros <-. apply IHr. reflexivity.
+       injection H as <-. apply IHr. reflexivity.
        destruct o; simpl.
-         injection H. intros <-. reflexivity.
+         injection H as <-. reflexivity.
          destruct (max_elt l); simpl in *.
-           injection H. intros <-. apply IHl. reflexivity.
+           injection H as <-. apply IHl. reflexivity.
            discriminate.
   Qed.
 
@@ -1147,15 +1147,15 @@ Module PositiveSet <: S with Module E:=PositiveOrderedTypeBits.
     induction s as [|l IHl o r IHr]; intros x y H H'.
       discriminate.
       simpl in H. case_eq (max_elt r).
-        intros p Hp. rewrite Hp in H. injection H; intros <-.
+        intros p Hp. rewrite Hp in H. injection H as <-.
         destruct y as [z|z|]; simpl; intro; trivial. apply (IHr p z); trivial.
         intro Hp; rewrite Hp in H. apply max_elt_3 in Hp.
         destruct o.
-          injection H. intros <- Hl. clear H.
+          injection H as <-. intros Hl.
           destruct y as [z|z|]; simpl; trivial. elim (Hp _ H').
 
           destruct (max_elt l).
-            injection H. intros <-. clear H.
+            injection H as <-.
             destruct y as [z|z|].
               elim (Hp _ H').
               apply (IHl e z); trivial.
diff --git a/theories/FSets/FSetWeakList.v b/theories/FSets/FSetWeakList.v
index 2ea32e97c..9dbea8849 100644
--- a/theories/FSets/FSetWeakList.v
+++ b/theories/FSets/FSetWeakList.v
@@ -8,7 +8,7 @@
 
 (** * Finite sets library *)
 
-(** This file proposes an implementation of the non-dependant
+(** This file proposes an implementation of the non-dependent
     interface [FSetInterface.WS] using lists without redundancy. *)
 
 Require Import FSetInterface.
diff --git a/theories/Init/Logic_Type.v b/theories/Init/Logic_Type.v
index 4a5f2ad69..4536dfc0f 100644
--- a/theories/Init/Logic_Type.v
+++ b/theories/Init/Logic_Type.v
@@ -64,7 +64,7 @@ Definition identity_rect_r :
  intros A x P H y H0; case identity_sym with (1 := H0); trivial.
 Defined.
 
-Hint Immediate identity_sym not_identity_sym: core v62.
+Hint Immediate identity_sym not_identity_sym: core.
 
 Notation refl_id := identity_refl (compat "8.3").
 Notation sym_id := identity_sym (compat "8.3").
diff --git a/theories/Init/Peano.v b/theories/Init/Peano.v
index 3749baf61..6c4a63501 100644
--- a/theories/Init/Peano.v
+++ b/theories/Init/Peano.v
@@ -33,7 +33,6 @@ Open Scope nat_scope.
 Definition eq_S := f_equal S.
 Definition f_equal_nat := f_equal (A:=nat).
 
-Hint Resolve eq_S: v62.
 Hint Resolve f_equal_nat: core.
 
 (** The predecessor function *)
@@ -41,7 +40,6 @@ Hint Resolve f_equal_nat: core.
 Notation pred := Nat.pred (compat "8.4").
 
 Definition f_equal_pred := f_equal pred.
-Hint Resolve f_equal_pred: v62.
 
 Theorem pred_Sn : forall n:nat, n = pred (S n).
 Proof.
@@ -85,7 +83,6 @@ Notation plus := Nat.add (compat "8.4").
 Infix "+" := Nat.add : nat_scope.
 
 Definition f_equal2_plus := f_equal2 plus.
-Hint Resolve f_equal2_plus: v62.
 Definition f_equal2_nat := f_equal2 (A1:=nat) (A2:=nat). 
 Hint Resolve f_equal2_nat: core.
 
diff --git a/theories/Init/Specif.v b/theories/Init/Specif.v
index 6c0221856..9fc00e80c 100644
--- a/theories/Init/Specif.v
+++ b/theories/Init/Specif.v
@@ -9,6 +9,7 @@
 (** Basic specifications : sets that may contain logical information *)
 
 Set Implicit Arguments.
+Set Reversible Pattern Implicit.
 
 Require Import Notations.
 Require Import Datatypes.
@@ -298,7 +299,7 @@ Proof.
   apply (h2 h1).
 Defined.
 
-Hint Resolve left right inleft inright: core v62.
+Hint Resolve left right inleft inright: core.
 Hint Resolve exist exist2 existT existT2: core.
 
 (* Compatibility *)
diff --git a/theories/Init/Tactics.v b/theories/Init/Tactics.v
index 59fdbb42f..5d1e87ae0 100644
--- a/theories/Init/Tactics.v
+++ b/theories/Init/Tactics.v
@@ -55,12 +55,6 @@ Ltac contradict H :=
    | _ => (elim H;fail) || pos H
   end.
 
-(* Transforming a negative goal [ H:~A |- ~B ] into a positive one [ B |- A ]*)
-
-Ltac swap H :=
-  idtac "swap is OBSOLETE: use contradict instead.";
-  intro; apply H; clear H.
-
 (* To contradict an hypothesis without copying its type. *)
 
 Ltac absurd_hyp H :=
@@ -79,7 +73,7 @@ Ltac case_eq x := generalize (eq_refl x); pattern x at -1; case x.
 
 (* use either discriminate or injection on a hypothesis *)
 
-Ltac destr_eq H := discriminate H || (try (injection H; clear H; intro H)).
+Ltac destr_eq H := discriminate H || (try (injection H as H)).
 
 (* Similar variants of destruct *)
 
diff --git a/theories/Init/Wf.v b/theories/Init/Wf.v
index 985ecaf27..b5b17e5e8 100644
--- a/theories/Init/Wf.v
+++ b/theories/Init/Wf.v
@@ -34,7 +34,7 @@ Section Well_founded.
   destruct 1; trivial.
  Defined.
 
- Global Implicit Arguments Acc_inv [x y] [x].
+ Global Arguments Acc_inv [x] _ [y] _, [x] _ y _.
 
  (** A relation is well-founded if every element is accessible *)
 
diff --git a/theories/Lists/List.v b/theories/Lists/List.v
index b66699220..30f1dec22 100644
--- a/theories/Lists/List.v
+++ b/theories/Lists/List.v
@@ -21,12 +21,13 @@ Set Implicit Arguments.
 
 Open Scope list_scope.
 
-(** Standard notations for lists. 
+(** Standard notations for lists.
 In a special module to avoid conflicts. *)
 Module ListNotations.
-Notation " [ ] " := nil (format "[ ]") : list_scope.
-Notation " [ x ] " := (cons x nil) : list_scope.
-Notation " [ x ; y ; .. ; z ] " :=  (cons x (cons y .. (cons z nil) ..)) : list_scope.
+Notation "[ ]" := nil (format "[ ]") : list_scope.
+Notation "[ x ]" := (cons x nil) : list_scope.
+Notation "[ x ; y ; .. ; z ]" :=  (cons x (cons y .. (cons z nil) ..)) : list_scope.
+Notation "[ x ; .. ; y ]" := (cons x .. (cons y nil) ..) (compat "8.4") : list_scope.
 End ListNotations.
 
 Import ListNotations.
@@ -195,7 +196,7 @@ Section Facts.
   Qed.
 
   Theorem app_nil_r : forall l:list A, l ++ [] = l.
-  Proof. 
+  Proof.
     induction l; simpl; f_equal; auto.
   Qed.
 
@@ -248,8 +249,7 @@ Section Facts.
     generalize (app_nil_r l); intros E.
     rewrite -> E; auto.
     intros.
-    injection H.
-    intro.
+    injection H as H H0.
     assert ([] = l ++ a0 :: l0) by auto.
     apply app_cons_not_nil in H1 as [].
   Qed.
@@ -335,16 +335,16 @@ Section Facts.
     absurd (length (x1 :: l1 ++ l) <= length l).
     simpl; rewrite app_length; auto with arith.
     rewrite H; auto with arith.
-    injection H; clear H; intros; f_equal; eauto.
+    injection H as H H0; f_equal; eauto.
   Qed.
 
 End Facts.
 
-Hint Resolve app_assoc app_assoc_reverse: datatypes v62.
-Hint Resolve app_comm_cons app_cons_not_nil: datatypes v62.
-Hint Immediate app_eq_nil: datatypes v62.
-Hint Resolve app_eq_unit app_inj_tail: datatypes v62.
-Hint Resolve in_eq in_cons in_inv in_nil in_app_or in_or_app: datatypes v62.
+Hint Resolve app_assoc app_assoc_reverse: datatypes.
+Hint Resolve app_comm_cons app_cons_not_nil: datatypes.
+Hint Immediate app_eq_nil: datatypes.
+Hint Resolve app_eq_unit app_inj_tail: datatypes.
+Hint Resolve in_eq in_cons in_inv in_nil in_app_or in_or_app: datatypes.
 
 
 
@@ -518,7 +518,7 @@ Section Elts.
   Proof.
     revert l.
     induction n as [|n IH]; intros [|x l] H; simpl in *; try easy.
-    - exists nil; exists l. injection H; clear H; intros; now subst.
+    - exists nil; exists l. now injection H as ->.
     - destruct (IH _ H) as (l1 & l2 & H1 & H2).
       exists (x::l1); exists l2; simpl; split; now f_equal.
   Qed.
@@ -1385,9 +1385,8 @@ End Fold_Right_Recursor.
     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.
+      induction l, l'; simpl; trivial; try discriminate.
+      now intros [= ->%IHl].
     Qed.
 
     Lemma in_combine_l : forall (l:list A)(l':list B)(x:A)(y:B),
@@ -1471,7 +1470,7 @@ End Fold_Right_Recursor.
       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.
+      injection H2 as -> ->; intuition.
       intuition.
     Qed.
 
@@ -1545,7 +1544,7 @@ Section length_order.
 End length_order.
 
 Hint Resolve lel_refl lel_cons_cons lel_cons lel_nil lel_nil nil_cons:
-  datatypes v62.
+  datatypes.
 
 
 (******************************)
@@ -1614,7 +1613,7 @@ Section SetIncl.
 End SetIncl.
 
 Hint Resolve incl_refl incl_tl incl_tran incl_appl incl_appr incl_cons
-  incl_app: datatypes v62.
+  incl_app: datatypes.
 
 
 (**************************************)
@@ -2366,7 +2365,7 @@ Notation rev_acc := rev_append (only parsing).
 Notation rev_acc_rev := rev_append_rev (only parsing).
 Notation AllS := Forall (only parsing). (* was formerly in TheoryList *)
 
-Hint Resolve app_nil_end : datatypes v62.
+Hint Resolve app_nil_end : datatypes.
 (* end hide *)
 
 Section Repeat.
diff --git a/theories/Lists/Streams.v b/theories/Lists/Streams.v
index 7ec3d2503..1c302b22f 100644
--- a/theories/Lists/Streams.v
+++ b/theories/Lists/Streams.v
@@ -51,7 +51,7 @@ Lemma tl_nth_tl :
 Proof.
   simple induction n; simpl; auto.
 Qed.
-Hint Resolve tl_nth_tl: datatypes v62.
+Hint Resolve tl_nth_tl: datatypes.
 
 Lemma Str_nth_tl_plus :
  forall (n m:nat) (s:Stream),
diff --git a/theories/Logic/Eqdep.v b/theories/Logic/Eqdep.v
index f3a2783e1..5ef86b8e7 100644
--- a/theories/Logic/Eqdep.v
+++ b/theories/Logic/Eqdep.v
@@ -33,5 +33,5 @@ Export EqdepTheory.
 
 (** Exported hints *)
 
-Hint Resolve eq_dep_eq: eqdep v62.
+Hint Resolve eq_dep_eq: eqdep.
 Hint Resolve inj_pair2 inj_pairT2: eqdep.
diff --git a/theories/Logic/EqdepFacts.v b/theories/Logic/EqdepFacts.v
index 30e26c7c6..bd59159bb 100644
--- a/theories/Logic/EqdepFacts.v
+++ b/theories/Logic/EqdepFacts.v
@@ -164,7 +164,7 @@ Proof.
   split; auto using eq_sig_eq_dep, eq_dep_eq_sig.
 Qed.
 
-(** Dependent equality is equivalent tco a dependent pair of equalities *)
+(** Dependent equality is equivalent to a dependent pair of equalities *)
 
 Set Implicit Arguments.
 
diff --git a/theories/Logic/FunctionalExtensionality.v b/theories/Logic/FunctionalExtensionality.v
index 04d9a6704..9551fea1a 100644
--- a/theories/Logic/FunctionalExtensionality.v
+++ b/theories/Logic/FunctionalExtensionality.v
@@ -56,6 +56,78 @@ Proof.
   apply functional_extensionality in H. destruct H. reflexivity.
 Defined.
 
+(** A version of [functional_extensionality_dep] which is provably
+    equal to [eq_refl] on [fun _ => eq_refl] *)
+Definition functional_extensionality_dep_good
+           {A} {B : A -> Type}
+           (f g : forall x : A, B x)
+           (H : forall x, f x = g x)
+  : f = g
+  := eq_trans (eq_sym (functional_extensionality_dep f f (fun _ => eq_refl)))
+              (functional_extensionality_dep f g H).
+
+Lemma functional_extensionality_dep_good_refl {A B} f
+  : @functional_extensionality_dep_good A B f f (fun _ => eq_refl) = eq_refl.
+Proof.
+  unfold functional_extensionality_dep_good; edestruct functional_extensionality_dep; reflexivity.
+Defined.
+
+Opaque functional_extensionality_dep_good.
+
+Lemma forall_sig_eq_rect
+      {A B} (f : forall a : A, B a)
+      (P : { g : _ | (forall a, f a = g a) } -> Type)
+      (k : P (exist (fun g => forall a, f a = g a) f (fun a => eq_refl)))
+      g
+: P g.
+Proof.
+  destruct g as [g1 g2].
+  set (g' := fun x => (exist _ (g1 x) (g2 x))).
+  change g2 with (fun x => proj2_sig (g' x)).
+  change g1 with (fun x => proj1_sig (g' x)).
+  clearbody g'; clear g1 g2.
+  cut (forall x, (exist _ (f x) eq_refl) = g' x).
+  { intro H'.
+    apply functional_extensionality_dep_good in H'.
+    destruct H'.
+    exact k. }
+  { intro x.
+    destruct (g' x) as [g'x1 g'x2].
+    destruct g'x2.
+    reflexivity. }
+Defined.
+
+Definition forall_eq_rect
+      {A B} (f : forall a : A, B a)
+      (P : forall g, (forall a, f a = g a) -> Type)
+      (k : P f (fun a => eq_refl))
+      g H
+  : P g H
+  := @forall_sig_eq_rect A B f (fun g => P (proj1_sig g) (proj2_sig g)) k (exist _ g H).
+
+Definition forall_eq_rect_comp {A B} f P k
+  : @forall_eq_rect A B f P k f (fun _ => eq_refl) = k.
+Proof.
+  unfold forall_eq_rect, forall_sig_eq_rect; simpl.
+  rewrite functional_extensionality_dep_good_refl; reflexivity.
+Qed.
+
+Definition f_equal__functional_extensionality_dep_good
+           {A B f g} H a
+  : f_equal (fun h => h a) (@functional_extensionality_dep_good A B f g H) = H a.
+Proof.
+  apply forall_eq_rect with (H := H); clear H g.
+  change (eq_refl (f a)) with (f_equal (fun h => h a) (eq_refl f)).
+  apply f_equal, functional_extensionality_dep_good_refl.
+Defined.
+
+Definition f_equal__functional_extensionality_dep_good__fun
+           {A B f g} H
+  : (fun a => f_equal (fun h => h a) (@functional_extensionality_dep_good A B f g H)) = H.
+Proof.
+  apply functional_extensionality_dep_good; intro a; apply f_equal__functional_extensionality_dep_good.
+Defined.
+
 (** Apply [functional_extensionality], introducing variable x. *)
 
 Tactic Notation "extensionality" ident(x) :=
@@ -68,6 +140,87 @@ Tactic Notation "extensionality" ident(x) :=
      apply forall_extensionality) ; intro x
   end.
 
+(** Iteratively apply [functional_extensionality] on an hypothesis
+    until finding an equality statement *)
+(* Note that you can write [Ltac extensionality_in_checker tac ::= tac tt.] to get a more informative error message. *)
+Ltac extensionality_in_checker tac :=
+  first [ tac tt | fail 1 "Anomaly: Unexpected error in extensionality tactic.  Please report." ].
+Tactic Notation "extensionality" "in" hyp(H) :=
+  let rec check_is_extensional_equality H :=
+      lazymatch type of H with
+      | _ = _ => constr:(Prop)
+      | forall a : ?A, ?T
+        => let Ha := fresh in
+           constr:(forall a : A, match H a with Ha => ltac:(let v := check_is_extensional_equality Ha in exact v) end)
+      end in
+  let assert_is_extensional_equality H :=
+      first [ let dummy := check_is_extensional_equality H in idtac
+            | fail 1 "Not an extensional equality" ] in
+  let assert_not_intensional_equality H :=
+      lazymatch type of H with
+      | _ = _ => fail "Already an intensional equality"
+      | _ => idtac
+      end in
+  let enforce_no_body H :=
+      (tryif (let dummy := (eval unfold H in H) in idtac)
+        then clearbody H
+        else idtac) in
+  let rec extensionality_step_make_type H :=
+      lazymatch type of H with
+      | forall a : ?A, ?f = ?g
+        => constr:({ H' | (fun a => f_equal (fun h => h a) H') = H })
+      | forall a : ?A, _
+        => let H' := fresh in
+           constr:(forall a : A, match H a with H' => ltac:(let ret := extensionality_step_make_type H' in exact ret) end)
+      end in
+  let rec eta_contract T :=
+      lazymatch (eval cbv beta in T) with
+      | context T'[fun a : ?A => ?f a]
+        => let T'' := context T'[f] in
+           eta_contract T''
+      | ?T => T
+      end in
+  let rec lift_sig_extensionality H :=
+      lazymatch type of H with
+      | sig _ => H
+      | forall a : ?A, _
+        => let Ha := fresh in
+           let ret := constr:(fun a : A => match H a with Ha => ltac:(let v := lift_sig_extensionality Ha in exact v) end) in
+           lazymatch type of ret with
+           | forall a : ?A, sig (fun b : ?B => @?f a b = @?g a b)
+             => eta_contract (exist (fun b : (forall a : A, B) => (fun a : A => f a (b a)) = (fun a : A => g a (b a)))
+                                    (fun a : A => proj1_sig (ret a))
+                                    (@functional_extensionality_dep_good _ _ _ _ (fun a : A => proj2_sig (ret a))))
+           end
+      end in
+  let extensionality_pre_step H H_out Heq :=
+      let T := extensionality_step_make_type H in
+      let H' := fresh in
+      assert (H' : T) by (intros; eexists; apply f_equal__functional_extensionality_dep_good__fun);
+      let H''b := lift_sig_extensionality H' in
+      case H''b; clear H';
+      intros H_out Heq in
+  let rec extensionality_rec H H_out Heq :=
+      lazymatch type of H with
+      | forall a, _ = _
+        => extensionality_pre_step H H_out Heq
+      | _
+        => let pre_H_out' := fresh H_out in
+           let H_out' := fresh pre_H_out' in
+           extensionality_pre_step H H_out' Heq;
+           let Heq' := fresh Heq in
+           extensionality_rec H_out' H_out Heq';
+           subst H_out'
+      end in
+  first [ assert_is_extensional_equality H | fail 1 "Not an extensional equality" ];
+  first [ assert_not_intensional_equality H | fail 1 "Already an intensional equality" ];
+  (tryif enforce_no_body H then idtac else clearbody H);
+  let H_out := fresh in
+  let Heq := fresh "Heq" in
+  extensionality_in_checker ltac:(fun tt => extensionality_rec H H_out Heq);
+  (* If we [subst H], things break if we already have another equation of the form [_ = H] *)
+  destruct Heq; rename H_out into H.
+
 (** Eta expansion follows from extensionality. *)
 
 Lemma eta_expansion_dep {A} {B : A -> Type} (f : forall x : A, B x) :
diff --git a/theories/Logic/Hurkens.v b/theories/Logic/Hurkens.v
index 841f843c0..56e03e965 100644
--- a/theories/Logic/Hurkens.v
+++ b/theories/Logic/Hurkens.v
@@ -562,7 +562,7 @@ End Paradox.
 End NoRetractFromSmallPropositionToProp.
 
 
-(** * Large universes are no retracts of [Prop]. *)
+(** * Large universes are not retracts of [Prop]. *)
 
 (** The existence in the Calculus of Constructions with universes of a
     retract from some [Type] universe into [Prop] is inconsistent. *)
diff --git a/theories/MSets/MSetAVL.v b/theories/MSets/MSetAVL.v
index cc023cc3f..a3c265a21 100644
--- a/theories/MSets/MSetAVL.v
+++ b/theories/MSets/MSetAVL.v
@@ -417,6 +417,7 @@ Local Open Scope Int_scope.
     Let's do its job by hand: *)
 
 Ltac join_tac :=
+ let l := fresh "l" in
  intro l; induction l as [| lh ll _ lx lr Hlr];
    [ | intros x r; induction r as [| rh rl Hrl rx rr _]; unfold join;
      [ | destruct ((rh+2) <? lh) eqn:LT;
diff --git a/theories/MSets/MSetDecide.v b/theories/MSets/MSetDecide.v
index f2555791b..9c622fd78 100644
--- a/theories/MSets/MSetDecide.v
+++ b/theories/MSets/MSetDecide.v
@@ -357,17 +357,8 @@ the above form:
         | _ => idtac
       end.
 
-    (** [if t then t1 else t2] executes [t] and, if it does not
-        fail, then [t1] will be applied to all subgoals
-        produced.  If [t] fails, then [t2] is executed. *)
-    Tactic Notation
-      "if" tactic(t)
-      "then" tactic(t1)
-      "else" tactic(t2) :=
-      first [ t; first [ t1 | fail 2 ] | t2 ].
-
     Ltac abstract_term t :=
-      if (is_var t) then fail "no need to abstract a variable"
+      tryif (is_var t) then fail "no need to abstract a variable"
       else (let x := fresh "x" in set (x := t) in *; try clearbody x).
 
     Ltac abstract_elements :=
@@ -478,11 +469,11 @@ the above form:
       repeat (
         match goal with
         | H : context [ @Logic.eq ?T ?x ?y ] |- _ =>
-          if (change T with E.t in H) then fail
-          else if (change T with t in H) then fail
+          tryif (change T with E.t in H) then fail
+          else tryif (change T with t in H) then fail
           else clear H
         | H : ?P |- _ =>
-          if prop (MSet_Prop P) holds by
+          tryif prop (MSet_Prop P) holds by
             (auto 100 with MSet_Prop)
           then fail
           else clear H
@@ -747,7 +738,7 @@ the above form:
     | H: (In ?x ?r) -> False |- (E.eq ?y ?x) -> False =>
       contradict H; fsetdec_body
     | H: ?P -> False |- ?Q -> False =>
-      if prop (MSet_elt_Prop P) holds by
+      tryif prop (MSet_elt_Prop P) holds by
         (auto 100 with MSet_Prop)
       then (contradict H; fsetdec_body)
       else fsetdec_body
diff --git a/theories/MSets/MSetInterface.v b/theories/MSets/MSetInterface.v
index bd8811689..74a7f6df8 100644
--- a/theories/MSets/MSetInterface.v
+++ b/theories/MSets/MSetInterface.v
@@ -345,6 +345,9 @@ Module Type WRawSets (E : DecidableType).
       predicate [Ok]. If [Ok] isn't decidable, [isok] may be the
       always-false function. *)
   Parameter isok : t -> bool.
+  (** MS: 
+    Dangerous instance, the [isok s = true] hypothesis cannot be discharged
+   with typeclass resolution. Is it really an instance? *)
   Declare Instance isok_Ok s `(isok s = true) : Ok s | 10.
 
   (** Logical predicates *)
diff --git a/theories/MSets/MSetList.v b/theories/MSets/MSetList.v
index fb0d1ad9d..05c20eb8f 100644
--- a/theories/MSets/MSetList.v
+++ b/theories/MSets/MSetList.v
@@ -8,7 +8,7 @@
 
 (** * Finite sets library *)
 
-(** This file proposes an implementation of the non-dependant
+(** This file proposes an implementation of the non-dependent
     interface [MSetInterface.S] using strictly ordered list. *)
 
 Require Export MSetInterface OrdersFacts OrdersLists.
diff --git a/theories/MSets/MSetPositive.v b/theories/MSets/MSetPositive.v
index 8dd240f46..be95a0379 100644
--- a/theories/MSets/MSetPositive.v
+++ b/theories/MSets/MSetPositive.v
@@ -908,10 +908,10 @@ Module PositiveSet <: S with Module E:=PositiveOrderedTypeBits.
       destruct o.
         intros x H. injection H; intros; subst. reflexivity.
         revert IHl. case choose.
-          intros p Hp x H. injection H; intros; subst; clear H. apply Hp.
+          intros p Hp x H. injection H as <-. apply Hp.
            reflexivity.
           intros _ x. revert IHr. case choose.
-            intros p Hp H. injection H; intros; subst; clear H. apply Hp.
+            intros p Hp H. injection H as <-. apply Hp.
             reflexivity.
             intros. discriminate.
   Qed.
@@ -968,11 +968,11 @@ Module PositiveSet <: S with Module E:=PositiveOrderedTypeBits.
    induction s as [| l IHl o r IHr]; simpl.
      intros. discriminate.
      intros x. destruct (min_elt l); intros.
-       injection H. intros <-. apply IHl. reflexivity.
+       injection H as <-. apply IHl. reflexivity.
        destruct o; simpl.
-         injection H. intros <-. reflexivity.
+         injection H as <-. reflexivity.
          destruct (min_elt r); simpl in *.
-           injection H. intros <-. apply IHr. reflexivity.
+           injection H as <-. apply IHr. reflexivity.
            discriminate.
   Qed.
 
@@ -996,15 +996,15 @@ Module PositiveSet <: S with Module E:=PositiveOrderedTypeBits.
     induction s as [|l IHl o r IHr]; intros x y H H'.
       discriminate.
       simpl in H. case_eq (min_elt l).
-        intros p Hp. rewrite Hp in H. injection H; intros <-.
+        intros p Hp. rewrite Hp in H. injection H as <-.
         destruct y as [z|z|]; simpl; intro; trivial. apply (IHl p z); trivial.
         intro Hp; rewrite Hp in H. apply min_elt_spec3 in Hp.
         destruct o.
-          injection H. intros <- Hl. clear H.
+          injection H as <-. intros Hl.
           destruct y as [z|z|]; simpl; trivial. elim (Hp _ H').
 
           destruct (min_elt r).
-            injection H. intros <-. clear H.
+            injection H as <-.
             destruct y as [z|z|].
               apply (IHr e z); trivial.
               elim (Hp _ H').
@@ -1021,11 +1021,11 @@ Module PositiveSet <: S with Module E:=PositiveOrderedTypeBits.
    induction s as [| l IHl o r IHr]; simpl.
      intros. discriminate.
      intros x. destruct (max_elt r); intros.
-       injection H. intros <-. apply IHr. reflexivity.
+       injection H as <-. apply IHr. reflexivity.
        destruct o; simpl.
-         injection H. intros <-. reflexivity.
+         injection H as <-. reflexivity.
          destruct (max_elt l); simpl in *.
-           injection H. intros <-. apply IHl. reflexivity.
+           injection H as <-. apply IHl. reflexivity.
            discriminate.
   Qed.
 
@@ -1049,15 +1049,15 @@ Module PositiveSet <: S with Module E:=PositiveOrderedTypeBits.
     induction s as [|l IHl o r IHr]; intros x y H H'.
       discriminate.
       simpl in H. case_eq (max_elt r).
-        intros p Hp. rewrite Hp in H. injection H; intros <-.
+        intros p Hp. rewrite Hp in H. injection H as <-.
         destruct y as [z|z|]; simpl; intro; trivial. apply (IHr p z); trivial.
         intro Hp; rewrite Hp in H. apply max_elt_spec3 in Hp.
         destruct o.
-          injection H. intros <- Hl. clear H.
+          injection H as <-. intros Hl.
           destruct y as [z|z|]; simpl; trivial. elim (Hp _ H').
 
           destruct (max_elt l).
-            injection H. intros <-. clear H.
+            injection H as <-.
             destruct y as [z|z|].
               elim (Hp _ H').
               apply (IHl e z); trivial.
diff --git a/theories/MSets/MSetRBT.v b/theories/MSets/MSetRBT.v
index 751d4f35c..83a2343dd 100644
--- a/theories/MSets/MSetRBT.v
+++ b/theories/MSets/MSetRBT.v
@@ -911,7 +911,7 @@ Proof.
      { inversion_clear O.
        assert (InT x l) by now apply min_elt_spec1. auto. }
      simpl. case X.compare_spec; try order.
-     destruct lc; injection E; clear E; intros; subst l s0; auto.
+     destruct lc; injection E; subst l s0; auto.
 Qed.
 
 Lemma remove_min_spec1 s x s' `{Ok s}:
@@ -1948,7 +1948,7 @@ Module Make (X: Orders.OrderedType) <:
  generalize (fun x s' => @Raw.remove_min_spec1 s x s' Hs).
  set (P := Raw.remove_min_ok s). clearbody P.
  destruct (Raw.remove_min s) as [(x0,s0)|]; try easy.
- intros H U. injection U. clear U; intros; subst. simpl.
+ intros H U. injection U as -> <-. simpl.
  destruct (H x s0); auto. subst; intuition.
  Qed.
 
diff --git a/theories/MSets/MSetWeakList.v b/theories/MSets/MSetWeakList.v
index 372acd56a..2ac57a932 100644
--- a/theories/MSets/MSetWeakList.v
+++ b/theories/MSets/MSetWeakList.v
@@ -8,7 +8,7 @@
 
 (** * Finite sets library *)
 
-(** This file proposes an implementation of the non-dependant
+(** This file proposes an implementation of the non-dependent
     interface [MSetWeakInterface.S] using lists without redundancy. *)
 
 Require Import MSetInterface.
diff --git a/theories/Numbers/BigNumPrelude.v b/theories/Numbers/BigNumPrelude.v
index 45a7527c9..bd8930872 100644
--- a/theories/Numbers/BigNumPrelude.v
+++ b/theories/Numbers/BigNumPrelude.v
@@ -10,7 +10,7 @@
 
 (** * BigNumPrelude *)
 
-(** Auxillary functions & theorems used for arbitrary precision efficient
+(** Auxiliary functions & theorems used for arbitrary precision efficient
     numbers. *)
 
 
@@ -22,7 +22,7 @@ Require Export Zpow_facts.
 Declare ML Module "numbers_syntax_plugin".
 
 (* *** Nota Bene ***
-   All results that were general enough has been moved in ZArith.
+   All results that were general enough have been moved in ZArith.
    Only remain here specialized lemmas and compatibility elements.
    (P.L. 5/11/2007).
 *)
diff --git a/theories/Numbers/Cyclic/ZModulo/ZModulo.v b/theories/Numbers/Cyclic/ZModulo/ZModulo.v
index c115a831d..04fc5a8df 100644
--- a/theories/Numbers/Cyclic/ZModulo/ZModulo.v
+++ b/theories/Numbers/Cyclic/ZModulo/ZModulo.v
@@ -369,7 +369,7 @@ Section ZModulo.
  assert (Z.div_eucl ([|x|]*[|y|]) wB = (([|x|]*[|y|])/wB,([|x|]*[|y|]) mod wB)).
   unfold Z.modulo, Z.div; destruct Z.div_eucl; auto.
  generalize (Z_div_mod ([|x|]*[|y|]) wB wB_pos); destruct Z.div_eucl as (h,l).
- destruct 1; injection H; clear H; intros.
+ destruct 1; injection H as ? ?.
  rewrite H0.
  assert ([|l|] = l).
   apply Zmod_small; auto.
@@ -411,7 +411,7 @@ Section ZModulo.
   unfold Z.modulo, Z.div; destruct Z.div_eucl; auto.
  generalize (Z_div_mod [|a|] [|b|] H0).
  destruct Z.div_eucl as (q,r); destruct 1; intros.
- injection H1; clear H1; intros.
+ injection H1 as ? ?.
  assert ([|r|]=r).
   apply Zmod_small; generalize (Z_mod_lt b wB wB_pos); fold [|b|];
    auto with zarith.
@@ -522,7 +522,7 @@ Section ZModulo.
   unfold Z.modulo, Z.div; destruct Z.div_eucl; auto.
  generalize (Z_div_mod a [|b|] H3).
  destruct Z.div_eucl as (q,r); destruct 1; intros.
- injection H4; clear H4; intros.
+ injection H4 as ? ?.
  assert ([|r|]=r).
   apply Zmod_small; generalize (Z_mod_lt b wB wB_pos); fold [|b|];
    auto with zarith.
diff --git a/theories/Numbers/Integer/Abstract/ZDivEucl.v b/theories/Numbers/Integer/Abstract/ZDivEucl.v
index 278e1bcff..c2fa69e53 100644
--- a/theories/Numbers/Integer/Abstract/ZDivEucl.v
+++ b/theories/Numbers/Integer/Abstract/ZDivEucl.v
@@ -30,18 +30,23 @@ Require Import ZAxioms ZMulOrder ZSgnAbs NZDiv.
     We just ignore them here.
 *)
 
-Module Type EuclidSpec (Import A : ZAxiomsSig')(Import B : DivMod' A).
- Axiom mod_always_pos : forall a b, b ~= 0 -> 0 <= a mod b < abs b.
+Module Type EuclidSpec (Import A : ZAxiomsSig')(Import B : DivMod A).
+ Axiom mod_always_pos : forall a b, b ~= 0 -> 0 <= B.modulo a b < abs b.
 End EuclidSpec.
 
 Module Type ZEuclid (Z:ZAxiomsSig) := NZDiv.NZDiv Z <+ EuclidSpec Z.
-Module Type ZEuclid' (Z:ZAxiomsSig) := NZDiv.NZDiv' Z <+ EuclidSpec Z.
 
 Module ZEuclidProp
  (Import A : ZAxiomsSig')
  (Import B : ZMulOrderProp A)
  (Import C : ZSgnAbsProp A B)
- (Import D : ZEuclid' A).
+ (Import D : ZEuclid A).
+
+ (** We put notations in a scope, to avoid warnings about
+     redefinitions of notations *)
+ Infix "/" := D.div : euclid.
+ Infix "mod" := D.modulo : euclid.
+ Local Open Scope euclid.
 
  Module Import Private_NZDiv := Nop <+ NZDivProp A D B.
 
@@ -615,4 +620,3 @@ intros (c,Hc). rewrite Hc. now apply mod_mul.
 Qed.
 
 End ZEuclidProp.
-
diff --git a/theories/Numbers/Integer/BigZ/BigZ.v b/theories/Numbers/Integer/BigZ/BigZ.v
index 56cb9bbc2..7c76011f2 100644
--- a/theories/Numbers/Integer/BigZ/BigZ.v
+++ b/theories/Numbers/Integer/BigZ/BigZ.v
@@ -138,7 +138,7 @@ intros NEQ.
 generalize (BigZ.spec_div_eucl a b).
 generalize (Z_div_mod_full [a] [b] NEQ).
 destruct BigZ.div_eucl as (q,r), Z.div_eucl as (q',r').
-intros (EQ,_). injection 1. intros EQr EQq.
+intros (EQ,_). injection 1 as EQr EQq.
 BigZ.zify. rewrite EQr, EQq; auto.
 Qed.
 
diff --git a/theories/Numbers/Integer/BigZ/ZMake.v b/theories/Numbers/Integer/BigZ/ZMake.v
index 8673b8a58..fec6e0683 100644
--- a/theories/Numbers/Integer/BigZ/ZMake.v
+++ b/theories/Numbers/Integer/BigZ/ZMake.v
@@ -147,7 +147,7 @@ Module Make (NN:NType) <: ZType.
  Proof.
  apply Bool.eq_iff_eq_true.
  rewrite Z.leb_le. unfold Z.le, leb. rewrite spec_compare.
- destruct Z.compare; split; try easy. now destruct 1.
+ now destruct Z.compare; split.
  Qed.
 
  Definition min n m := match compare n m with Gt => m | _ => n end.
@@ -427,13 +427,13 @@ Module Make (NN:NType) <: ZType.
  (* Pos Neg *)
  generalize (NN.spec_div_eucl x y); destruct (NN.div_eucl x y) as (q,r).
  break_nonneg x px EQx; break_nonneg y py EQy;
- try (injection 1; intros Hr Hq; rewrite NN.spec_eqb, NN.spec_0, Hr;
+ try (injection 1 as Hq Hr; rewrite NN.spec_eqb, NN.spec_0, Hr;
       simpl; rewrite Hq, NN.spec_0; auto).
  change (- Zpos py) with (Zneg py).
  assert (GT : Zpos py > 0) by (compute; auto).
  generalize (Z_div_mod (Zpos px) (Zpos py) GT).
  unfold Z.div_eucl. destruct (Z.pos_div_eucl px (Zpos py)) as (q',r').
- intros (EQ,MOD). injection 1. intros Hr' Hq'.
+ intros (EQ,MOD). injection 1 as Hq' Hr'.
  rewrite NN.spec_eqb, NN.spec_0, Hr'.
  break_nonneg r pr EQr.
  subst; simpl. rewrite NN.spec_0; auto.
@@ -442,13 +442,13 @@ Module Make (NN:NType) <: ZType.
  (* Neg Pos *)
  generalize (NN.spec_div_eucl x y); destruct (NN.div_eucl x y) as (q,r).
  break_nonneg x px EQx; break_nonneg y py EQy;
- try (injection 1; intros Hr Hq; rewrite NN.spec_eqb, NN.spec_0, Hr;
+ try (injection 1 as Hq Hr; rewrite NN.spec_eqb, NN.spec_0, Hr;
       simpl; rewrite Hq, NN.spec_0; auto).
  change (- Zpos px) with (Zneg px).
  assert (GT : Zpos py > 0) by (compute; auto).
  generalize (Z_div_mod (Zpos px) (Zpos py) GT).
  unfold Z.div_eucl. destruct (Z.pos_div_eucl px (Zpos py)) as (q',r').
- intros (EQ,MOD). injection 1. intros Hr' Hq'.
+ intros (EQ,MOD). injection 1 as Hq' Hr'.
  rewrite NN.spec_eqb, NN.spec_0, Hr'.
  break_nonneg r pr EQr.
  subst; simpl. rewrite NN.spec_0; auto.
@@ -457,7 +457,7 @@ Module Make (NN:NType) <: ZType.
  (* Neg Neg *)
  generalize (NN.spec_div_eucl x y); destruct (NN.div_eucl x y) as (q,r).
  break_nonneg x px EQx; break_nonneg y py EQy;
- try (injection 1; intros Hr Hq; rewrite Hr, Hq; auto).
+ try (injection 1 as -> ->; auto).
  simpl. intros <-; auto.
  Qed.
 
diff --git a/theories/Numbers/NatInt/NZGcd.v b/theories/Numbers/NatInt/NZGcd.v
index 1d3672943..44088f8c4 100644
--- a/theories/Numbers/NatInt/NZGcd.v
+++ b/theories/Numbers/NatInt/NZGcd.v
@@ -60,8 +60,6 @@ Proof.
  intros n. exists 0. now nzsimpl.
 Qed.
 
-Hint Rewrite divide_1_l divide_0_r : nz.
-
 Lemma divide_0_l : forall n, (0 | n) -> n==0.
 Proof.
  intros n (m,Hm). revert Hm. now nzsimpl.
diff --git a/theories/Numbers/Natural/BigN/BigN.v b/theories/Numbers/Natural/BigN/BigN.v
index ec1017f50..e8ff516f3 100644
--- a/theories/Numbers/Natural/BigN/BigN.v
+++ b/theories/Numbers/Natural/BigN/BigN.v
@@ -110,7 +110,7 @@ intros NEQ.
 generalize (BigN.spec_div_eucl a b).
 generalize (Z_div_mod_full [a] [b] NEQ).
 destruct BigN.div_eucl as (q,r), Z.div_eucl as (q',r').
-intros (EQ,_). injection 1. intros EQr EQq.
+intros (EQ,_). injection 1 as EQr EQq.
 BigN.zify. rewrite EQr, EQq; auto.
 Qed.
 
diff --git a/theories/Numbers/Natural/BigN/NMake.v b/theories/Numbers/Natural/BigN/NMake.v
index 98949736c..1425041a1 100644
--- a/theories/Numbers/Natural/BigN/NMake.v
+++ b/theories/Numbers/Natural/BigN/NMake.v
@@ -338,7 +338,7 @@ Module Make (W0:CyclicType) <: NType.
  Proof.
  apply eq_iff_eq_true.
  rewrite Z.leb_le. unfold Z.le, leb. rewrite spec_compare.
- destruct Z.compare; split; try easy. now destruct 1.
+ now destruct Z.compare; split.
  Qed.
 
  Definition min (n m : t) : t := match compare n m with Gt => m | _ => n end.
diff --git a/theories/Numbers/Natural/BigN/NMake_gen.ml b/theories/Numbers/Natural/BigN/NMake_gen.ml
index 601fa108f..5177fae65 100644
--- a/theories/Numbers/Natural/BigN/NMake_gen.ml
+++ b/theories/Numbers/Natural/BigN/NMake_gen.ml
@@ -147,7 +147,7 @@ pr
   pr " Local Notation Size := (SizePlus O).";
   pr "";
 
-  pr " Tactic Notation \"do_size\" tactic(t) := do %i t." (size+1);
+  pr " Tactic Notation (at level 3) \"do_size\" tactic3(t) := do %i t." (size+1);
   pr "";
 
   pr " Definition dom_t n := match n with";
diff --git a/theories/Numbers/Rational/SpecViaQ/QSig.v b/theories/Numbers/Rational/SpecViaQ/QSig.v
index a40d94059..8e20fd060 100644
--- a/theories/Numbers/Rational/SpecViaQ/QSig.v
+++ b/theories/Numbers/Rational/SpecViaQ/QSig.v
@@ -115,7 +115,10 @@ Ltac solve_wd2 := intros x x' Hx y y' Hy; qify; now rewrite Hx, Hy.
 Local Obligation Tactic := solve_wd2 || solve_wd1.
 
 Instance : Measure to_Q.
-Instance eq_equiv : Equivalence eq := {}.
+Instance eq_equiv : Equivalence eq.
+Proof.
+  change eq with (RelCompFun Qeq to_Q); apply _.
+Defined.
 
 Program Instance lt_wd : Proper (eq==>eq==>iff) lt.
 Program Instance le_wd : Proper (eq==>eq==>iff) le.
@@ -141,7 +144,10 @@ Proof. intros. qify. destruct (Qcompare_spec [x] [y]); auto. Qed.
 (** Let's implement [TotalOrder] *)
 
 Definition lt_compat := lt_wd.
-Instance lt_strorder : StrictOrder lt := {}.
+Instance lt_strorder : StrictOrder lt.
+Proof.
+  change lt with (RelCompFun Qlt to_Q); apply _.
+Qed.
 
 Lemma le_lteq : forall x y, x<=y <-> x<y \/ x==y.
 Proof. intros. qify. apply Qle_lteq. Qed.
diff --git a/theories/PArith/BinPos.v b/theories/PArith/BinPos.v
index 0ccfad7b2..7baf102aa 100644
--- a/theories/PArith/BinPos.v
+++ b/theories/PArith/BinPos.v
@@ -201,7 +201,6 @@ Proof.
 Qed.
 
 (** ** No neutral elements for addition *)
-
 Lemma add_no_neutral p q : q + p <> p.
 Proof.
   revert q.
@@ -508,7 +507,7 @@ Qed.
 Lemma mul_xO_discr p q : p~0 * q <> q.
 Proof.
   induction q; try discriminate.
-  rewrite mul_xO_r; injection; assumption.
+  rewrite mul_xO_r; injection; auto.
 Qed.
 
 (** ** Simplification properties of multiplication *)
diff --git a/theories/Program/Equality.v b/theories/Program/Equality.v
index 17f05c511..d6f9bb9df 100644
--- a/theories/Program/Equality.v
+++ b/theories/Program/Equality.v
@@ -8,7 +8,6 @@
 
 (** Tactics related to (dependent) equality and proof irrelevance. *)
 
-Require Export ProofIrrelevance.
 Require Export JMeq.
 
 Require Import Coq.Program.Tactics.
@@ -143,7 +142,7 @@ Ltac pi_eq_proof_hyp p :=
       | [ H : X = Y |- _ ] =>
         match p with
           | H => fail 2
-          | _ => rewrite (proof_irrelevance (X = Y) p H)
+          | _ => rewrite (UIP _ X Y p H)
         end
       | _ => fail " No hypothesis with same type "
     end
@@ -166,7 +165,7 @@ Hint Rewrite <- eq_rect_eq : refl_id.
    [coerce_* t eq_refl = t]. *)
 
 Lemma JMeq_eq_refl {A} (x : A) : JMeq_eq (@JMeq_refl _ x) = eq_refl.
-Proof. apply proof_irrelevance. Qed.
+Proof. apply UIP. Qed.
 
 Lemma UIP_refl_refl A (x : A) :
   Eqdep.EqdepTheory.UIP_refl A x eq_refl = eq_refl.
@@ -333,7 +332,7 @@ Ltac simplify_one_dep_elim_term c :=
       (let hyp := fresh in intros hyp ;
         move hyp before y ; revert_until hyp ; generalize dependent y ;
           refine (solution_right _ _ _ _)(*  ; intros until 0 *))
-    | ?f ?x = ?g ?y -> _ => let H := fresh in progress (intros H ; injection H ; clear H)
+    | ?f ?x = ?g ?y -> _ => let H := fresh in progress (intros H ; simple injection H; clear H)
     | ?t = ?u -> _ => let hyp := fresh in
       intros hyp ; exfalso ; discriminate
     | ?x = ?y -> _ => let hyp := fresh in
diff --git a/theories/Program/Subset.v b/theories/Program/Subset.v
index c8f37318d..2a3ec926b 100644
--- a/theories/Program/Subset.v
+++ b/theories/Program/Subset.v
@@ -9,6 +9,7 @@
 
 Require Import Coq.Program.Utils.
 Require Import Coq.Program.Equality.
+Require Export ProofIrrelevance.
 
 Local Open Scope program_scope.
 
diff --git a/theories/Program/Tactics.v b/theories/Program/Tactics.v
index 7384790da..dfd6b0eae 100644
--- a/theories/Program/Tactics.v
+++ b/theories/Program/Tactics.v
@@ -264,7 +264,7 @@ Ltac bang :=
   match goal with
     | |- ?x =>
       match x with
-        | appcontext [False_rect _ ?p] => elim p
+        | context [False_rect _ ?p] => elim p
       end
   end.
 
diff --git a/theories/Program/Wf.v b/theories/Program/Wf.v
index a2fd05cd9..c490ea516 100644
--- a/theories/Program/Wf.v
+++ b/theories/Program/Wf.v
@@ -211,7 +211,7 @@ Ltac fold_sub f :=
   match goal with
     | [ |- ?T ] =>
       match T with
-        appcontext C [ @Fix_sub _ _ _ _ _ ?arg ] =>
+        context C [ @Fix_sub _ _ _ _ _ ?arg ] =>
         let app := context C [ f arg ] in
           change app
       end
diff --git a/theories/QArith/Qcanon.v b/theories/QArith/Qcanon.v
index 6bfa47bc5..9f9651d84 100644
--- a/theories/QArith/Qcanon.v
+++ b/theories/QArith/Qcanon.v
@@ -84,7 +84,7 @@ Arguments Q2Qc q%Q.
 Lemma Q2Qc_eq_iff (q q' : Q) : Q2Qc q = Q2Qc q' <-> q == q'.
 Proof.
  split; intro H.
- - injection H. apply Qred_eq_iff.
+ - now injection H as H%Qred_eq_iff.
  - apply Qc_is_canon. simpl. now rewrite H.
 Qed.
 
@@ -266,7 +266,7 @@ Theorem Qcmult_integral : forall x y, x*y=0 -> x=0 \/ y=0.
 Proof.
   intros.
   destruct (Qmult_integral x y); try qc; auto.
-  injection H; clear H; intros.
+  injection H as H.
   rewrite <- (Qred_correct (x*y)).
   rewrite <- (Qred_correct 0).
   rewrite H; auto with qarith.
diff --git a/theories/Reals/RIneq.v b/theories/Reals/RIneq.v
index f26bac2bb..379fee6f4 100644
--- a/theories/Reals/RIneq.v
+++ b/theories/Reals/RIneq.v
@@ -389,7 +389,7 @@ Lemma Rplus_ne : forall r, r + 0 = r /\ 0 + r = r.
 Proof.
   split; ring.
 Qed.
-Hint Resolve Rplus_ne: real v62.
+Hint Resolve Rplus_ne: real.
 
 (**********)
 
@@ -425,7 +425,6 @@ Proof.
   apply (f_equal (fun v => v + r)).
 Qed.
 
-(*i Old i*)Hint Resolve Rplus_eq_compat_l: v62.
 
 (**********)
 Lemma Rplus_eq_reg_l : forall r r1 r2, r + r1 = r + r2 -> r1 = r2.
@@ -501,21 +500,21 @@ Lemma Rmult_0_r : forall r, r * 0 = 0.
 Proof.
   intro; ring.
 Qed.
-Hint Resolve Rmult_0_r: real v62.
+Hint Resolve Rmult_0_r: real.
 
 (**********)
 Lemma Rmult_0_l : forall r, 0 * r = 0.
 Proof.
   intro; ring.
 Qed.
-Hint Resolve Rmult_0_l: real v62.
+Hint Resolve Rmult_0_l: real.
 
 (**********)
 Lemma Rmult_ne : forall r, r * 1 = r /\ 1 * r = r.
 Proof.
   intro; split; ring.
 Qed.
-Hint Resolve Rmult_ne: real v62.
+Hint Resolve Rmult_ne: real.
 
 (**********)
 Lemma Rmult_1_r : forall r, r * 1 = r.
@@ -530,7 +529,6 @@ Proof.
   auto with real.
 Qed.
 
-(*i Old i*)Hint Resolve Rmult_eq_compat_l: v62.
 
 Lemma Rmult_eq_compat_r : forall r r1 r2, r1 = r2 -> r1 * r = r2 * r.
 Proof.
@@ -646,7 +644,7 @@ Lemma Ropp_0 : -0 = 0.
 Proof.
   ring.
 Qed.
-Hint Resolve Ropp_0: real v62.
+Hint Resolve Ropp_0: real.
 
 (**********)
 Lemma Ropp_eq_0_compat : forall r, r = 0 -> - r = 0.
diff --git a/theories/Reals/Ranalysis_reg.v b/theories/Reals/Ranalysis_reg.v
index e57af7311..0c27d407c 100644
--- a/theories/Reals/Ranalysis_reg.v
+++ b/theories/Reals/Ranalysis_reg.v
@@ -109,6 +109,7 @@ Ltac intro_hyp_glob trm :=
     | Rabs => idtac
     | ?X1 =>
       let p := constr:(X1) in
+      let HYPPD := fresh "HYPPD" in
         match goal with
           | _:(derivable p) |- _ => idtac
           |  |- (derivable p) => idtac
@@ -250,6 +251,7 @@ Ltac intro_hyp_pt trm pt :=
       end
     | ?X1 =>
       let p := constr:(X1) in
+      let HYPPD := fresh "HYPPD" in
         match goal with
           | _:(derivable_pt p pt) |- _ => idtac
           |  |- (derivable_pt p pt) => idtac
@@ -341,8 +343,10 @@ Ltac is_diff_pt :=
     | _:(derivable_pt ?X1 ?X2) |- (derivable_pt ?X1 ?X2) =>
       assumption
     | _:(derivable ?X1) |- (derivable_pt ?X1 ?X2) =>
+      let HypDDPT := fresh "HypDDPT" in
       cut (derivable X1); [ intro HypDDPT; apply HypDDPT | assumption ]
     |  |- (True -> derivable_pt _ _) =>
+      let HypTruE := fresh "HypTruE" in
       intro HypTruE; clear HypTruE; is_diff_pt
     | _ =>
       try
@@ -411,6 +415,7 @@ Ltac is_diff_glob :=
       apply (derivable_comp X2 X1); is_diff_glob
     | _:(derivable ?X1) |- (derivable ?X1) => assumption
     |  |- (True -> derivable _) =>
+      let HypTruE := fresh "HypTruE" in
       intro HypTruE; clear HypTruE; is_diff_glob
     | _ =>
       try
@@ -490,14 +495,17 @@ Ltac is_cont_pt :=
     | _:(continuity_pt ?X1 ?X2) |- (continuity_pt ?X1 ?X2) =>
       assumption
     | _:(continuity ?X1) |- (continuity_pt ?X1 ?X2) =>
+      let HypDDPT := fresh "HypDDPT" in
       cut (continuity X1); [ intro HypDDPT; apply HypDDPT | assumption ]
     | _:(derivable_pt ?X1 ?X2) |- (continuity_pt ?X1 ?X2) =>
       apply derivable_continuous_pt; assumption
     | _:(derivable ?X1) |- (continuity_pt ?X1 ?X2) =>
+      let HypDDPT := fresh "HypDDPT" in
       cut (continuity X1);
         [ intro HypDDPT; apply HypDDPT
           | apply derivable_continuous; assumption ]
     |  |- (True -> continuity_pt _ _) =>
+      let HypTruE := fresh "HypTruE" in
       intro HypTruE; clear HypTruE; is_cont_pt
     | _ =>
       try
@@ -567,6 +575,7 @@ Ltac is_cont_glob :=
       apply (continuity_comp X2 X1); try is_cont_glob || assumption
     | _:(continuity ?X1) |- (continuity ?X1) => assumption
     |  |- (True -> continuity _) =>
+      let HypTruE := fresh "HypTruE" in
       intro HypTruE; clear HypTruE; is_cont_glob
     | _:(derivable ?X1) |- (continuity ?X1) =>
       apply derivable_continuous; assumption
diff --git a/theories/Reals/Raxioms.v b/theories/Reals/Raxioms.v
index 9d55e4e63..9fbda92a2 100644
--- a/theories/Reals/Raxioms.v
+++ b/theories/Reals/Raxioms.v
@@ -32,7 +32,7 @@ Hint Resolve Rplus_assoc: real.
 
 (**********)
 Axiom Rplus_opp_r : forall r:R, r + - r = 0.
-Hint Resolve Rplus_opp_r: real v62.
+Hint Resolve Rplus_opp_r: real.
 
 (**********)
 Axiom Rplus_0_l : forall r:R, 0 + r = r.
@@ -44,11 +44,11 @@ Hint Resolve Rplus_0_l: real.
 
 (**********)
 Axiom Rmult_comm : forall r1 r2:R, r1 * r2 = r2 * r1.
-Hint Resolve Rmult_comm: real v62.
+Hint Resolve Rmult_comm: real.
 
 (**********)
 Axiom Rmult_assoc : forall r1 r2 r3:R, r1 * r2 * r3 = r1 * (r2 * r3).
-Hint Resolve Rmult_assoc: real v62.
+Hint Resolve Rmult_assoc: real.
 
 (**********)
 Axiom Rinv_l : forall r:R, r <> 0 -> / r * r = 1.
@@ -69,7 +69,7 @@ Hint Resolve R1_neq_R0: real.
 (**********)
 Axiom
   Rmult_plus_distr_l : forall r1 r2 r3:R, r1 * (r2 + r3) = r1 * r2 + r1 * r3.
-Hint Resolve Rmult_plus_distr_l: real v62.
+Hint Resolve Rmult_plus_distr_l: real.
 
 (*********************************************************)
 (** *    Order axioms                                    *)
diff --git a/theories/Reals/Sqrt_reg.v b/theories/Reals/Sqrt_reg.v
index 10527442e..d43baee8c 100644
--- a/theories/Reals/Sqrt_reg.v
+++ b/theories/Reals/Sqrt_reg.v
@@ -339,7 +339,7 @@ Proof.
   rewrite <- H1; rewrite sqrt_0; unfold Rminus; rewrite Ropp_0;
     rewrite Rplus_0_r; rewrite <- H1 in H5; unfold Rminus in H5;
       rewrite Ropp_0 in H5; rewrite Rplus_0_r in H5.
-  destruct (Rcase_abs x0) as [Hlt|Hgt]_eqn:Heqs.
+  destruct (Rcase_abs x0) as [Hlt|Hgt] eqn:Heqs.
   unfold sqrt. rewrite Heqs.
   rewrite Rabs_R0; apply H2.
   rewrite Rabs_right.
diff --git a/theories/Relations/Operators_Properties.v b/theories/Relations/Operators_Properties.v
index 220cebeac..fe8a96acc 100644
--- a/theories/Relations/Operators_Properties.v
+++ b/theories/Relations/Operators_Properties.v
@@ -36,7 +36,7 @@ Section Properties.
   Section Clos_Refl_Trans.
 
     Local Notation "R *" := (clos_refl_trans R)
-      (at level 8, left associativity, format "R *").
+      (at level 8, no associativity, format "R *").
 
     (** Correctness of the reflexive-transitive closure operator *)
 
diff --git a/theories/Relations/Relation_Definitions.v b/theories/Relations/Relation_Definitions.v
index b6005b9d1..9c98879ce 100644
--- a/theories/Relations/Relation_Definitions.v
+++ b/theories/Relations/Relation_Definitions.v
@@ -66,10 +66,10 @@ Section Relation_Definition.
 
 End Relation_Definition.
 
-Hint Unfold reflexive transitive antisymmetric symmetric: sets v62.
+Hint Unfold reflexive transitive antisymmetric symmetric: sets.
 
 Hint Resolve Build_preorder Build_order Build_equivalence Build_PER
   preord_refl preord_trans ord_refl ord_trans ord_antisym equiv_refl
-  equiv_trans equiv_sym per_sym per_trans: sets v62.
+  equiv_trans equiv_sym per_sym per_trans: sets.
 
-Hint Unfold inclusion same_relation commut: sets v62.
+Hint Unfold inclusion same_relation commut: sets.
diff --git a/theories/Relations/Relation_Operators.v b/theories/Relations/Relation_Operators.v
index ffd682d62..88239475c 100644
--- a/theories/Relations/Relation_Operators.v
+++ b/theories/Relations/Relation_Operators.v
@@ -226,9 +226,9 @@ Section Lexicographic_Exponentiation.
 
 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.
+Hint Unfold transp union: sets.
+Hint Resolve t_step rt_step rt_refl rst_step rst_refl: sets.
+Hint Immediate rst_sym: sets.
 
 (* begin hide *)
 (* Compatibility *)
diff --git a/theories/Sets/Classical_sets.v b/theories/Sets/Classical_sets.v
index 8a4bb9f42..837437a22 100644
--- a/theories/Sets/Classical_sets.v
+++ b/theories/Sets/Classical_sets.v
@@ -122,4 +122,4 @@ Section Ensembles_classical.
 End Ensembles_classical.
 
  Hint Resolve Strict_super_set_contains_new_element Subtract_intro
-  not_SIncl_empty: sets v62.
+  not_SIncl_empty: sets.
diff --git a/theories/Sets/Constructive_sets.v b/theories/Sets/Constructive_sets.v
index 8d2344f93..6291248eb 100644
--- a/theories/Sets/Constructive_sets.v
+++ b/theories/Sets/Constructive_sets.v
@@ -141,4 +141,4 @@ End Ensembles_facts.
 Hint Resolve Singleton_inv Singleton_intro Add_intro1 Add_intro2
   Intersection_inv Couple_inv Setminus_intro Strict_Included_intro
   Strict_Included_strict Noone_in_empty Inhabited_not_empty Add_not_Empty
-  not_Empty_Add Inhabited_add Included_Empty: sets v62.
+  not_Empty_Add Inhabited_add Included_Empty: sets.
diff --git a/theories/Sets/Ensembles.v b/theories/Sets/Ensembles.v
index 8f579214a..0fefb354b 100644
--- a/theories/Sets/Ensembles.v
+++ b/theories/Sets/Ensembles.v
@@ -90,9 +90,8 @@ Section Ensembles.
 
 End Ensembles.
 
-Hint Unfold In Included Same_set Strict_Included Add Setminus Subtract: sets
-  v62.
+Hint Unfold In Included Same_set Strict_Included Add Setminus Subtract: sets.
 
 Hint Resolve Union_introl Union_intror Intersection_intro In_singleton
   Couple_l Couple_r Triple_l Triple_m Triple_r Disjoint_intro
-  Extensionality_Ensembles: sets v62.
+  Extensionality_Ensembles: sets.
diff --git a/theories/Sets/Finite_sets.v b/theories/Sets/Finite_sets.v
index f38dd6fdf..edbc1efec 100644
--- a/theories/Sets/Finite_sets.v
+++ b/theories/Sets/Finite_sets.v
@@ -43,8 +43,8 @@ Section Ensembles_finis.
 
 End Ensembles_finis.
 
-Hint Resolve Empty_is_finite Union_is_finite: sets v62.
-Hint Resolve card_empty card_add: sets v62.
+Hint Resolve Empty_is_finite Union_is_finite: sets.
+Hint Resolve card_empty card_add: sets.
 
 Require Import Constructive_sets.
 
diff --git a/theories/Sets/Image.v b/theories/Sets/Image.v
index 34ea857d1..e74ef41e4 100644
--- a/theories/Sets/Image.v
+++ b/theories/Sets/Image.v
@@ -200,4 +200,4 @@ Section Image.
 
 End Image.
 
-Hint Resolve Im_def image_empty finite_image: sets v62.
+Hint Resolve Im_def image_empty finite_image: sets.
diff --git a/theories/Sets/Multiset.v b/theories/Sets/Multiset.v
index ec38b8923..42d0c76dc 100644
--- a/theories/Sets/Multiset.v
+++ b/theories/Sets/Multiset.v
@@ -187,7 +187,7 @@ End multiset_defs.
 
 Unset Implicit Arguments.
 
-Hint Unfold meq multiplicity: v62 datatypes.
+Hint Unfold meq multiplicity: datatypes.
 Hint Resolve munion_empty_right munion_comm munion_ass meq_left meq_right
-  munion_empty_left: v62 datatypes.
-Hint Immediate meq_sym: v62 datatypes.
+  munion_empty_left: datatypes.
+Hint Immediate meq_sym: datatypes.
diff --git a/theories/Sets/Partial_Order.v b/theories/Sets/Partial_Order.v
index 3610ebce6..335fec5b0 100644
--- a/theories/Sets/Partial_Order.v
+++ b/theories/Sets/Partial_Order.v
@@ -51,8 +51,8 @@ Section Partial_orders.
 
 End Partial_orders.
 
-Hint Unfold Carrier_of Rel_of Strict_Rel_of: sets v62.
-Hint Resolve Definition_of_covers: sets v62.
+Hint Unfold Carrier_of Rel_of Strict_Rel_of: sets.
+Hint Resolve Definition_of_covers: sets.
 
 
 Section Partial_order_facts.
diff --git a/theories/Sets/Powerset.v b/theories/Sets/Powerset.v
index d636e0468..7c2435da0 100644
--- a/theories/Sets/Powerset.v
+++ b/theories/Sets/Powerset.v
@@ -175,14 +175,14 @@ Qed.
 
 End The_power_set_partial_order.
 
-Hint Resolve Empty_set_minimal: sets v62.
-Hint Resolve Power_set_Inhabited: sets v62.
-Hint Resolve Inclusion_is_an_order: sets v62.
-Hint Resolve Inclusion_is_transitive: sets v62.
-Hint Resolve Union_minimal: sets v62.
-Hint Resolve Union_increases_l: sets v62.
-Hint Resolve Union_increases_r: sets v62.
-Hint Resolve Intersection_decreases_l: sets v62.
-Hint Resolve Intersection_decreases_r: sets v62.
-Hint Resolve Empty_set_is_Bottom: sets v62.
-Hint Resolve Strict_inclusion_is_transitive: sets v62.
+Hint Resolve Empty_set_minimal: sets.
+Hint Resolve Power_set_Inhabited: sets.
+Hint Resolve Inclusion_is_an_order: sets.
+Hint Resolve Inclusion_is_transitive: sets.
+Hint Resolve Union_minimal: sets.
+Hint Resolve Union_increases_l: sets.
+Hint Resolve Union_increases_r: sets.
+Hint Resolve Intersection_decreases_l: sets.
+Hint Resolve Intersection_decreases_r: sets.
+Hint Resolve Empty_set_is_Bottom: sets.
+Hint Resolve Strict_inclusion_is_transitive: sets.
diff --git a/theories/Sets/Powerset_Classical_facts.v b/theories/Sets/Powerset_Classical_facts.v
index 09c90506b..e802beac9 100644
--- a/theories/Sets/Powerset_Classical_facts.v
+++ b/theories/Sets/Powerset_Classical_facts.v
@@ -90,7 +90,7 @@ Section Sets_as_an_algebra.
     apply Subtract_intro; auto with sets.
     red; intro H'1; apply H'; rewrite H'1; auto with sets.
   Qed.
-  Hint Resolve incl_soustr_add_r: sets v62.
+  Hint Resolve incl_soustr_add_r: sets.
 
   Lemma add_soustr_2 :
     forall (X:Ensemble U) (x:U),
@@ -328,9 +328,9 @@ Section Sets_as_an_algebra.
 
 End Sets_as_an_algebra.
 
-Hint Resolve incl_soustr_in: sets v62.
-Hint Resolve incl_soustr: sets v62.
-Hint Resolve incl_soustr_add_l: sets v62.
-Hint Resolve incl_soustr_add_r: sets v62.
-Hint Resolve add_soustr_1 add_soustr_2: sets v62.
-Hint Resolve add_soustr_xy: sets v62.
+Hint Resolve incl_soustr_in: sets.
+Hint Resolve incl_soustr: sets.
+Hint Resolve incl_soustr_add_l: sets.
+Hint Resolve incl_soustr_add_r: sets.
+Hint Resolve add_soustr_1 add_soustr_2: sets.
+Hint Resolve add_soustr_xy: sets.
diff --git a/theories/Sets/Powerset_facts.v b/theories/Sets/Powerset_facts.v
index 63e84199d..e9696a1ca 100644
--- a/theories/Sets/Powerset_facts.v
+++ b/theories/Sets/Powerset_facts.v
@@ -254,5 +254,5 @@ Section Sets_as_an_algebra.
 End Sets_as_an_algebra.
 
 Hint Resolve Empty_set_zero Empty_set_zero' Union_associative Union_add
-  singlx incl_add: sets v62.
+  singlx incl_add: sets.
 
diff --git a/theories/Sets/Relations_1.v b/theories/Sets/Relations_1.v
index de96fa560..45fb8134c 100644
--- a/theories/Sets/Relations_1.v
+++ b/theories/Sets/Relations_1.v
@@ -60,6 +60,6 @@ Section Relations_1.
 
 End Relations_1.
 Hint Unfold Reflexive Transitive Antisymmetric Symmetric contains
-  same_relation: sets v62.
+  same_relation: sets.
 Hint Resolve Definition_of_preorder Definition_of_order
-  Definition_of_equivalence Definition_of_PER: sets v62.
+  Definition_of_equivalence Definition_of_PER: sets.
diff --git a/theories/Sets/Relations_2.v b/theories/Sets/Relations_2.v
index f1026e31a..1e0b83fe5 100644
--- a/theories/Sets/Relations_2.v
+++ b/theories/Sets/Relations_2.v
@@ -48,7 +48,7 @@ Definition Strongly_confluent : Prop :=
 
 End Relations_2.
 
-Hint Resolve Rstar_0: sets v62.
-Hint Resolve Rstar1_0: sets v62.
-Hint Resolve Rstar1_1: sets v62.
-Hint Resolve Rplus_0: sets v62.
+Hint Resolve Rstar_0: sets.
+Hint Resolve Rstar1_0: sets.
+Hint Resolve Rstar1_1: sets.
+Hint Resolve Rplus_0: sets.
diff --git a/theories/Sets/Relations_3.v b/theories/Sets/Relations_3.v
index 92b299885..c05b5ee76 100644
--- a/theories/Sets/Relations_3.v
+++ b/theories/Sets/Relations_3.v
@@ -51,10 +51,10 @@ Section Relations_3.
    Definition Noetherian : Prop := forall x:U, noetherian x.
 
 End Relations_3.
-Hint Unfold coherent: sets v62.
-Hint Unfold locally_confluent: sets v62.
-Hint Unfold confluent: sets v62.
-Hint Unfold Confluent: sets v62.
-Hint Resolve definition_of_noetherian: sets v62.
-Hint Unfold Noetherian: sets v62.
+Hint Unfold coherent: sets.
+Hint Unfold locally_confluent: sets.
+Hint Unfold confluent: sets.
+Hint Unfold Confluent: sets.
+Hint Resolve definition_of_noetherian: sets.
+Hint Unfold Noetherian: sets.
 
diff --git a/theories/Sorting/Permutation.v b/theories/Sorting/Permutation.v
index 8470b7955..44f8ff6a7 100644
--- a/theories/Sorting/Permutation.v
+++ b/theories/Sorting/Permutation.v
@@ -318,7 +318,7 @@ Lemma Permutation_length_2_inv :
 Proof.
   intros a1 a2 l H; remember [a1;a2] as m in H.
   revert a1 a2 Heqm.
-  induction H; intros; try (injection Heqm; intros; subst; clear Heqm);
+  induction H; intros; try (injection Heqm as ? ?; subst);
     discriminate || (try tauto).
   apply Permutation_length_1_inv in H as ->; left; auto.
   apply IHPermutation1 in Heqm as [H1|H1]; apply IHPermutation2 in H1 as [];
diff --git a/theories/Strings/Ascii.v b/theories/Strings/Ascii.v
index 97cb746f3..55a533c55 100644
--- a/theories/Strings/Ascii.v
+++ b/theories/Strings/Ascii.v
@@ -40,7 +40,7 @@ Defined.
 
 (** * Conversion between natural numbers modulo 256 and ascii characters *)
 
-(** Auxillary function that turns a positive into an ascii by
+(** Auxiliary function that turns a positive into an ascii by
    looking at the last 8 bits, ie z mod 2^8 *)
 
 Definition ascii_of_pos : positive -> ascii :=
diff --git a/theories/Strings/String.v b/theories/Strings/String.v
index 943bb48e9..451b65cbe 100644
--- a/theories/Strings/String.v
+++ b/theories/Strings/String.v
@@ -83,7 +83,7 @@ intros H; generalize (H 0); simpl; 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.
+intros H; injection H as H1 H2.
 rewrite H2; trivial.
 rewrite H1; auto.
 Qed.
@@ -238,14 +238,14 @@ intros n m s1 s2; generalize n m s1; clear n m s1; elim s2; simpl;
  auto.
 intros n; case n; simpl; auto.
 intros m s1; case s1; simpl; auto.
-intros H; injection H; intros H1; rewrite <- H1; auto.
+intros H; injection H as <-; auto.
 intros; discriminate.
 intros; discriminate.
 intros b s2' Rec n m s1.
 case n; simpl; auto.
 generalize (prefix_correct s1 (String b s2'));
  case (prefix s1 (String b s2')).
-intros H0 H; injection H; intros H1; rewrite <- H1; auto.
+intros H0 H; injection H as <-; auto.
 case H0; simpl; auto.
 case m; simpl; auto.
 case (index 0 s1 s2'); intros; discriminate.
@@ -271,7 +271,7 @@ intros n m s1 s2; generalize n m s1; clear n m s1; elim s2; simpl;
  auto.
 intros n; case n; simpl; auto.
 intros m s1; case s1; simpl; auto.
-intros H; injection H; intros H1; rewrite <- H1.
+intros H; injection H as <-.
 intros p H0 H2; inversion H2.
 intros; discriminate.
 intros; discriminate.
@@ -279,7 +279,7 @@ intros b s2' Rec n m s1.
 case n; simpl; auto.
 generalize (prefix_correct s1 (String b s2'));
  case (prefix s1 (String b s2')).
-intros H0 H; injection H; intros H1; rewrite <- H1; auto.
+intros H0 H; injection H as <-; auto.
 intros p H2 H3; inversion H3.
 case m; simpl; auto.
 case (index 0 s1 s2'); intros; discriminate.
diff --git a/theories/Structures/OrdersFacts.v b/theories/Structures/OrdersFacts.v
index 954d3df20..0115d8a54 100644
--- a/theories/Structures/OrdersFacts.v
+++ b/theories/Structures/OrdersFacts.v
@@ -434,21 +434,21 @@ Lemma eqb_compare x y :
  (x =? y) = match compare x y with Eq => true | _ => false end.
 Proof.
 apply eq_true_iff_eq. rewrite eqb_eq, <- compare_eq_iff.
-destruct compare; now split.
+now destruct compare.
 Qed.
 
 Lemma ltb_compare x y :
  (x <? y) = match compare x y with Lt => true | _ => false end.
 Proof.
 apply eq_true_iff_eq. rewrite ltb_lt, <- compare_lt_iff.
-destruct compare; now split.
+now destruct compare.
 Qed.
 
 Lemma leb_compare x y :
  (x <=? y) = match compare x y with Gt => false | _ => true end.
 Proof.
 apply eq_true_iff_eq. rewrite leb_le, <- compare_le_iff.
-destruct compare; split; try easy. now destruct 1.
+now destruct compare.
 Qed.
 
 End BoolOrderFacts.
diff --git a/theories/Vectors/VectorDef.v b/theories/Vectors/VectorDef.v
index c69223804..1f8b76cb6 100644
--- a/theories/Vectors/VectorDef.v
+++ b/theories/Vectors/VectorDef.v
@@ -30,7 +30,7 @@ Inductive t A : nat -> Type :=
   |nil : t A 0
   |cons : forall (h:A) (n:nat), t A n -> t A (S n).
 
-Local Notation "[]" := (nil _).
+Local Notation "[ ]" := (nil _) (format "[ ]").
 Local Notation "h :: t" := (cons _ h _ t) (at level 60, right associativity).
 
 Section SCHEMES.
@@ -102,7 +102,7 @@ Definition const {A} (a:A) := nat_rect _ [] (fun n x => cons _ a n x).
 
 Computational behavior of this function should be the same as
 ocaml function. *)
-Definition nth {A} := 
+Definition nth {A} :=
 fix nth_fix {m} (v' : t A m) (p : Fin.t m) {struct v'} : A :=
 match p in Fin.t m' return t A m' -> A with
  |Fin.F1 => caseS (fun n v' => A) (fun h n t => h)
@@ -293,12 +293,14 @@ Eval cbv delta beta in fold_right (fun h H => Datatypes.cons h H) v Datatypes.ni
 End VECTORLIST.
 
 Module VectorNotations.
-Notation "[]" := [] : vector_scope.
+Delimit Scope vector_scope with vector.
+Notation "[ ]" := [] (format "[ ]") : vector_scope.
+Notation "[]" := [] (compat "8.5") : vector_scope.
 Notation "h :: t" := (h :: t) (at level 60, right associativity)
   : vector_scope.
-Notation " [ x ] " := (x :: []) : vector_scope.
-Notation " [ x ; y ; .. ; z ] " := (cons _ x _ (cons _ y _ .. (cons _ z _ (nil _)) ..)) : vector_scope
-.
+Notation "[ x ]" := (x :: []) : vector_scope.
+Notation "[ x ; y ; .. ; z ]" := (cons _ x _ (cons _ y _ .. (cons _ z _ (nil _)) ..)) : vector_scope.
+Notation "[ x ; .. ; y ]" := (cons _ x _ .. (cons _ y _ (nil _)) ..) (compat "8.4") : vector_scope.
 Notation "v [@ p ]" := (nth v p) (at level 1, format "v [@ p ]") : vector_scope.
 Open Scope vector_scope.
 End VectorNotations.
diff --git a/theories/Wellfounded/Lexicographic_Product.v b/theories/Wellfounded/Lexicographic_Product.v
index 4b8447f49..b2ada2f91 100644
--- a/theories/Wellfounded/Lexicographic_Product.v
+++ b/theories/Wellfounded/Lexicographic_Product.v
@@ -44,14 +44,11 @@ Section WfLexicographic_Product.
     apply H2.
     auto with sets.
 
-    injection H1.
-    destruct 2.
-    injection H3.
-    destruct 2; auto with sets.
+    injection H1 as <- _.
+    injection H3 as <- _; auto with sets.
 
     rewrite <- H1.
-    injection H3; intros _ Hx1.
-    subst x1.
+    injection H3 as -> H3.
     apply IHAcc0.
     elim inj_pair2 with A B x y' x0; assumption.
   Defined.
diff --git a/theories/ZArith/Zwf.v b/theories/ZArith/Zwf.v
index 1ac00bddd..90754af3b 100644
--- a/theories/ZArith/Zwf.v
+++ b/theories/ZArith/Zwf.v
@@ -56,7 +56,7 @@ Section wf_proof.
 
 End wf_proof.
 
-Hint Resolve Zwf_well_founded: datatypes v62.
+Hint Resolve Zwf_well_founded: datatypes.
 
 
 (** We also define the other family of relations:
@@ -88,4 +88,4 @@ Section wf_proof_up.
 
 End wf_proof_up.
 
-Hint Resolve Zwf_up_well_founded: datatypes v62.
+Hint Resolve Zwf_up_well_founded: datatypes.
diff --git a/theories/theories.itarget b/theories/theories.itarget
deleted file mode 100644
index aacab2d97..000000000
--- a/theories/theories.itarget
+++ /dev/null
@@ -1,25 +0,0 @@
-Arith/vo.otarget
-Bool/vo.otarget
-Classes/vo.otarget
-Compat/vo.otarget
-FSets/vo.otarget
-MSets/vo.otarget
-Structures/vo.otarget
-Init/vo.otarget
-Lists/vo.otarget
-Vectors/vo.otarget
-Logic/vo.otarget
-PArith/vo.otarget
-NArith/vo.otarget
-Numbers/vo.otarget
-Program/vo.otarget
-QArith/vo.otarget
-Reals/vo.otarget
-Relations/vo.otarget
-Setoids/vo.otarget
-Sets/vo.otarget
-Sorting/vo.otarget
-Strings/vo.otarget
-Unicode/vo.otarget
-Wellfounded/vo.otarget
-ZArith/vo.otarget
diff --git a/tools/coq_makefile.ml b/tools/coq_makefile.ml
index 7b76514e4..624b9ced7 100644
--- a/tools/coq_makefile.ml
+++ b/tools/coq_makefile.ml
@@ -27,8 +27,9 @@ let rec print_list sep = function
   | x :: l -> print x; print sep; print_list sep l
   | [] -> ()
 
-let list_iter_i f =
-  let rec aux i = function [] -> () | a::l -> f i a; aux (i+1) l in aux 1
+let rec print_prefix_list sep = function
+  | x :: l -> print sep; print x; print_prefix_list sep l
+  | [] -> ()
 
 let section s =
   let l = String.length s in
@@ -49,8 +50,9 @@ let section s =
 let lib_dirs =
   ["kernel"; "lib"; "library"; "parsing";
    "pretyping"; "interp"; "printing"; "intf";
-   "proofs"; "tactics"; "tools"; "toplevel";
-   "stm"; "grammar"; "config"; "ltac"; "engine"]
+   "proofs"; "tactics"; "tools"; "ltacprof";
+   "vernac"; "stm"; "toplevel"; "grammar"; "config";
+   "ltac"; "engine"]
 
 
 let usage () =
@@ -103,8 +105,10 @@ let is_genrule r = (* generic rule (like bar%foo: ...) *)
       Str.string_match genrule r 0
 
 let string_prefix a b =
-  let rec aux i = try if a.[i] = b.[i] then aux (i+1) else i with |Invalid_argument _ -> i in
-    String.sub a 0 (aux 0)
+  let rec aux i =
+    try if a.[i] = b.[i] then aux (i+1) else i with Invalid_argument _ -> i
+  in
+  String.sub a 0 (aux 0)
 
 let is_prefix dir1 dir2 =
   let l1 = String.length dir1 in
@@ -119,7 +123,10 @@ let is_prefix dir1 dir2 =
 
 let physical_dir_of_logical_dir ldir =
   let le = String.length ldir - 1 in
-  let pdir = if le >= 0 && ldir.[le] = '.' then String.sub ldir 0 (le - 1) else String.copy ldir in
+  let pdir =
+    if le >= 0 && ldir.[le] = '.' then String.sub ldir 0 (le - 1)
+    else String.copy ldir
+  in
   for i = 0 to le - 1 do
     if pdir.[i] = '.' then pdir.[i] <- '/';
   done;
@@ -134,62 +141,74 @@ let standard opt =
   print "\"\n\n"
 
 let classify_files_by_root var files (inc_ml,inc_i,inc_r) =
-  if not (List.exists (fun (pdir,_,_) -> pdir = ".") inc_r)
-    && not (List.exists (fun (pdir,_,_) -> pdir = ".") inc_i) then
-    begin
-      let absdir_of_files = List.rev_map
+  if List.exists (fun (pdir,_,_) -> pdir = ".") inc_r ||
+     List.exists (fun (pdir,_,_) -> pdir = ".") inc_i
+  then ()
+  else
+    let absdir_of_files =List.rev_map
 	(fun x -> CUnix.canonical_path_name (Filename.dirname x))
-	files in
-	(* files in scope of a -I option (assuming they are no overlapping) *)
-      let has_inc_i = List.exists (fun (_,a) -> List.mem a absdir_of_files) inc_ml in
-	if has_inc_i then
-	  begin
-	    printf "%sINC=" var;
-	    List.iter (fun (pdir,absdir) ->
-			 if List.mem absdir absdir_of_files
-			 then printf
-			   "$(filter $(wildcard %s/*),$(%s)) "
-			   pdir var
-		      ) inc_ml;
-	    printf "\n";
-	  end;
-      (* Files in the scope of a -R option (assuming they are disjoint) *)
-	list_iter_i (fun i (pdir,_,abspdir) ->
-		       if List.exists (is_prefix abspdir) absdir_of_files then
-			 printf "%s%d=$(patsubst %s/%%,%%,$(filter %s/%%,$(%s)))\n"
-			   var i pdir pdir var)
-	  (inc_i@inc_r);
-    end
+	files
+    in
+    (* files in scope of a -I option (assuming they are no overlapping) *)
+    if List.exists (fun (_,a) -> List.mem a absdir_of_files) inc_ml then
+      begin
+	printf "%sINC=" var;
+	List.iter (fun (pdir,absdir) ->
+		   if List.mem absdir absdir_of_files
+		   then printf "$(filter $(wildcard %s/*),$(%s)) " pdir var)
+		  inc_ml;
+	printf "\n";
+      end;
+    (* Files in the scope of a -R option (assuming they are disjoint) *)
+    List.iteri (fun i (pdir,_,abspdir) ->
+		if List.exists (is_prefix abspdir) absdir_of_files then
+		  printf "%s%d=$(patsubst %s/%%,%%,$(filter %s/%%,$(%s)))\n"
+			 var i pdir pdir var)
+	       (inc_i@inc_r)
 
 let vars_to_put_by_root var_x_files_l (inc_ml,inc_i,inc_r) =
-  let var_x_absdirs_l = List.rev_map
-    (fun (v,l) -> (v,List.rev_map (fun x -> CUnix.canonical_path_name (Filename.dirname x)) l))
-    var_x_files_l in
-  let var_filter f g = List.fold_left (fun acc (var,dirs) ->
-    if f dirs
-    then (g var)::acc else acc) [] var_x_absdirs_l in
-    (* All files caught by a -R . option (assuming it is the only one) *)
+  let var_x_absdirs_l =
+    List.rev_map
+      (fun (v,l) ->
+       (v,List.rev_map
+            (fun x -> CUnix.canonical_path_name (Filename.dirname x)) l))
+      var_x_files_l
+  in
+  let var_filter f g =
+    List.fold_left
+      (fun acc (var,dirs) -> if f dirs then (g var)::acc else acc)
+      [] var_x_absdirs_l
+  in
+  (* All files caught by a -R . option (assuming it is the only one) *)
   match inc_i@inc_r with
-  |[(".",t,_)] -> (None,[".",physical_dir_of_logical_dir t,List.rev_map fst var_x_files_l])
+  |[(".",t,_)] ->
+    (None,[".",physical_dir_of_logical_dir t,List.rev_map fst var_x_files_l])
   |l ->
     try
       let out = List.assoc "." (List.rev_map (fun (p,l,_) -> (p,l)) l) in
-      let () = prerr_string "Warning: install rule assumes that -R/-Q . _ is the only -R/-Q option\n" in
+      let () = prerr_string "Warning: install rule assumes that -R/-Q . _ is the only -R/-Q option\n"
+      in
       (None,[".",physical_dir_of_logical_dir out,List.rev_map fst var_x_files_l])
     with Not_found ->
-      (
       (* vars for -Q options *)
-	Some (var_filter (fun l -> List.exists (fun (_,a) -> List.mem a l) inc_ml) (fun x -> x)),
+      let varq = var_filter
+                   (fun l -> List.exists (fun (_,a) -> List.mem a l) inc_ml)
+                   (fun x -> x)
+      in
       (* (physical dir, physical dir of logical path,vars) for -R options
 	 (assuming physical dirs are disjoint) *)
-      if l = [] then
-	[".","$(INSTALLDEFAULTROOT)",[]]
-      else
-	Util.List.fold_left_i (fun i out (pdir,ldir,abspdir) ->
-	  let vars_r = var_filter (List.exists (is_prefix abspdir)) (fun x -> x^string_of_int i) in
-	  let pdir' = physical_dir_of_logical_dir ldir in
-	  (pdir,pdir',vars_r)::out) 1 [] l
-      )
+      let other =
+        if l = [] then
+	  [".","$(INSTALLDEFAULTROOT)",[]]
+        else
+	  Util.List.fold_left_i (fun i out (pdir,ldir,abspdir) ->
+	    let vars_r = var_filter
+                           (List.exists (is_prefix abspdir))
+                           (fun x -> x^string_of_int i)
+            in
+	    let pdir' = physical_dir_of_logical_dir ldir in
+	    (pdir,pdir',vars_r)::out) 0 [] l
+      in (Some varq, other)
 
 let install_include_by_root perms =
   let install_dir for_i (pdir,pdir',vars) =
@@ -265,33 +284,38 @@ let where_put_doc = function
  install-doc will put anything in $INSTALLDEFAULTROOT\n" in
 	"$(INSTALLDEFAULTROOT)"
 
-let install (vfiles,(mlifiles,ml4files,mlfiles,mllibfiles,mlpackfiles),_,sds) inc = function
+let install (vfiles,(mlis,ml4s,mls,mllibs,mlpacks),_,sds) inc = function
   |Project_file.NoInstall -> ()
   |is_install ->
     let not_empty = function |[] -> false |_::_ -> true in
-    let cmofiles = List.rev_append mlpackfiles (List.rev_append mlfiles ml4files) in
-    let cmifiles = List.rev_append mlifiles cmofiles in
-    let cmxsfiles = List.rev_append cmofiles mllibfiles in
-    let where_what_cmxs = vars_to_put_by_root [("CMXSFILES",cmxsfiles)] inc in
+    let cmos = List.rev_append mlpacks (List.rev_append mls ml4s) in
+    let cmis = List.rev_append mlis cmos in
+    let cmxss = List.rev_append cmos mllibs in
+    let where_what_cmxs = vars_to_put_by_root [("CMXSFILES",cmxss)] inc in
     let where_what_oth = vars_to_put_by_root
-      [("VOFILES",vfiles);("VFILES",vfiles);("GLOBFILES",vfiles);("NATIVEFILES",vfiles);("CMOFILES",cmofiles);("CMIFILES",cmifiles);("CMAFILES",mllibfiles)]
+      [("VOFILES",vfiles);("VFILES",vfiles);
+       ("GLOBFILES",vfiles);("NATIVEFILES",vfiles);
+       ("CMOFILES",cmos);("CMIFILES",cmis);("CMAFILES",mllibs)]
       inc in
     let doc_dir = where_put_doc inc in
-    let () = if is_install = Project_file.UnspecInstall then
-	print "userinstall:\n\t+$(MAKE) USERINSTALL=true install\n\n" in
-    if (not_empty cmxsfiles) then begin
+    if is_install = Project_file.UnspecInstall then begin
+	print "userinstall:\n\t+$(MAKE) USERINSTALL=true install\n\n"
+    end;
+    if not_empty cmxss then begin
       print "install-natdynlink:\n";
       install_include_by_root "0755" where_what_cmxs;
       print "\n";
     end;
-    if (not_empty cmxsfiles) then begin
+    if not_empty cmxss then begin
       print "install-toploop: $(MLLIBFILES:.mllib=.cmxs)\n";
       printf "\t install -d \"$(DSTROOT)\"$(COQTOPINSTALL)/\n";
       printf "\t install -m 0755 $?  \"$(DSTROOT)\"$(COQTOPINSTALL)/\n";
       print "\n";
     end;
     print "install:";
-    if (not_empty cmxsfiles) then print "$(if $(HASNATDYNLINK_OR_EMPTY),install-natdynlink)";
+    if not_empty cmxss then begin
+      print "$(if $(HASNATDYNLINK_OR_EMPTY),install-natdynlink)";
+    end;
     print "\n";
     install_include_by_root "0644" where_what_oth;
     List.iter
@@ -306,7 +330,7 @@ let install (vfiles,(mlifiles,ml4files,mlfiles,mllibfiles,mlpackfiles),_,sds) in
       print "\tdone\n" in
     print "install-doc:\n";
     if not_empty vfiles then install_one_kind "html" doc_dir;
-    if not_empty mlifiles then install_one_kind "mlihtml" doc_dir;
+    if not_empty mlis then install_one_kind "mlihtml" doc_dir;
     print "\n";
     let uninstall_one_kind kind dir =
       printf "\tprintf 'cd \"$${DSTROOT}\"$(COQDOCINSTALL)/%s \\\\\\n' >> \"$@\"\n" dir;
@@ -316,10 +340,10 @@ let install (vfiles,(mlifiles,ml4files,mlfiles,mllibfiles,mlpackfiles),_,sds) in
     in
     printf "uninstall_me.sh: %s\n" !makefile_name;
     print "\techo '#!/bin/sh' > $@\n";
-    if (not_empty cmxsfiles) then uninstall_by_root where_what_cmxs;
+    if not_empty cmxss then uninstall_by_root where_what_cmxs;
     uninstall_by_root where_what_oth;
     if not_empty vfiles then uninstall_one_kind "html" doc_dir;
-    if not_empty mlifiles then uninstall_one_kind "mlihtml" doc_dir;
+    if not_empty mlis then uninstall_one_kind "mlihtml" doc_dir;
     print "\tchmod +x $@\n";
     print "\n";
     print "uninstall: uninstall_me.sh\n";
@@ -338,11 +362,14 @@ let make_makefile sds =
 
 let clean sds sps =
   print "clean::\n";
-  if !some_mlfile || !some_mlifile || !some_ml4file || !some_mllibfile || !some_mlpackfile then begin
-    print "\trm -f $(ALLCMOFILES) $(CMIFILES) $(CMAFILES)\n";
-    print "\trm -f $(ALLCMOFILES:.cmo=.cmx) $(CMXAFILES) $(CMXSFILES) $(ALLCMOFILES:.cmo=.o) $(CMXAFILES:.cmxa=.a)\n";
-    print "\trm -f $(addsuffix .d,$(MLFILES) $(MLIFILES) $(ML4FILES) $(MLLIBFILES) $(MLPACKFILES))\n";
-  end;
+  if !some_mlfile || !some_mlifile || !some_ml4file
+     || !some_mllibfile || !some_mlpackfile
+  then
+    begin
+      print "\trm -f $(ALLCMOFILES) $(CMIFILES) $(CMAFILES)\n";
+      print "\trm -f $(ALLCMOFILES:.cmo=.cmx) $(CMXAFILES) $(CMXSFILES) $(ALLCMOFILES:.cmo=.o) $(CMXAFILES:.cmxa=.a)\n";
+      print "\trm -f $(addsuffix .d,$(MLFILES) $(MLIFILES) $(ML4FILES) $(MLLIBFILES) $(MLPACKFILES))\n";
+    end;
   if !some_vfile then
     begin
       print "\trm -f $(OBJFILES) $(OBJFILES:.o=.native) $(NATIVEFILES)\n";
@@ -363,7 +390,7 @@ let clean sds sps =
   let () =
     if !some_vfile then
       let () = print "cleanall:: clean\n" in
-      print "\trm -f $(patsubst %.v,.%.aux,$(VFILES))\n\n" in
+      print "\trm -f $(foreach f,$(VFILES:.v=),$(dir $(f)).$(notdir $(f)).aux)\n\n" in
   print "archclean::\n";
   print "\trm -f *.cmx *.o\n";
   List.iter
@@ -379,48 +406,78 @@ let header_includes () = ()
 let implicit () =
     section "Implicit rules.";
   let mli_rules () =
-    print "$(MLIFILES:.mli=.cmi): %.cmi: %.mli\n\t$(CAMLC) $(ZDEBUG) $(ZFLAGS) $<\n\n";
+    print "$(MLIFILES:.mli=.cmi): %.cmi: %.mli\n";
+    print "\t$(SHOW)'CAMLC -c $<'\n";
+    print "\t$(HIDE)$(CAMLC) $(ZDEBUG) $(ZFLAGS) $<\n\n";
     print "$(addsuffix .d,$(MLIFILES)): %.mli.d: %.mli\n";
-    print "\t$(OCAMLFIND) ocamldep -slash $(OCAMLLIBS) \"$<\" > \"$@\" || ( RV=$$?; rm -f \"$@\"; exit $${RV} )\n\n" in
+    print "\t$(SHOW)'CAMLDEP $<'\n";
+    print "\t$(HIDE)$(CAMLDEP) $(OCAMLLIBS) \"$<\" > \"$@\" || ( RV=$$?; rm -f \"$@\"; exit $${RV} )\n\n"
+  in
   let ml4_rules () =
-    print "$(ML4FILES:.ml4=.cmo): %.cmo: %.ml4\n\t$(CAMLC) $(ZDEBUG) $(ZFLAGS) $(PP) -impl $<\n\n";
+    print "$(ML4FILES:.ml4=.cmo): %.cmo: %.ml4\n";
+    print "\t$(SHOW)'CAMLC -pp -c $<'\n";
+    print "\t$(HIDE)$(CAMLC) $(ZDEBUG) $(ZFLAGS) $(PP) -impl $<\n\n";
     print "$(filter-out $(addsuffix .cmx,$(foreach lib,$(MLPACKFILES:.mlpack=_MLPACK_DEPENDENCIES),$($(lib)))),$(ML4FILES:.ml4=.cmx)): %.cmx: %.ml4\n";
-    print "\t$(CAMLOPTC) $(ZDEBUG) $(ZFLAGS) $(PP) -impl $<\n\n";
+    print "\t$(SHOW)'CAMLOPT -pp -c $<'\n";
+    print "\t$(HIDE)$(CAMLOPTC) $(ZDEBUG) $(ZFLAGS) $(PP) -impl $<\n\n";
     print "$(addsuffix .d,$(ML4FILES)): %.ml4.d: %.ml4\n";
-    print "\t$(OCAMLFIND) ocamldep -slash $(OCAMLLIBS) $(PP) -impl \"$<\" > \"$@\" || ( RV=$$?; rm -f \"$@\"; exit $${RV} )\n\n" in
+    print "\t$(SHOW)'CAMLDEP -pp $<'\n";
+    print "\t$(HIDE)$(CAMLDEP) $(OCAMLLIBS) $(PP) -impl \"$<\" > \"$@\" || ( RV=$$?; rm -f \"$@\"; exit $${RV} )\n\n" in
   let ml_rules () =
-    print "$(MLFILES:.ml=.cmo): %.cmo: %.ml\n\t$(CAMLC) $(ZDEBUG) $(ZFLAGS) $<\n\n";
+    print "$(MLFILES:.ml=.cmo): %.cmo: %.ml\n";
+    print "\t$(SHOW)'CAMLC -c $<'\n";
+    print "\t$(HIDE)$(CAMLC) $(ZDEBUG) $(ZFLAGS) $<\n\n";
     print "$(filter-out $(addsuffix .cmx,$(foreach lib,$(MLPACKFILES:.mlpack=_MLPACK_DEPENDENCIES),$($(lib)))),$(MLFILES:.ml=.cmx)): %.cmx: %.ml\n";
-    print "\t$(CAMLOPTC) $(ZDEBUG) $(ZFLAGS) $<\n\n";
+    print "\t$(SHOW)'CAMLOPT -c $<'\n";
+    print "\t$(HIDE)$(CAMLOPTC) $(ZDEBUG) $(ZFLAGS) $<\n\n";
     print "$(addsuffix .d,$(MLFILES)): %.ml.d: %.ml\n";
-    print "\t$(OCAMLFIND) ocamldep -slash $(OCAMLLIBS) \"$<\" > \"$@\" || ( RV=$$?; rm -f \"$@\"; exit $${RV} )\n\n" in
+    print "\t$(SHOW)'CAMLDEP $<'\n";
+    print "\t$(HIDE)$(CAMLDEP) $(OCAMLLIBS) \"$<\" > \"$@\" || ( RV=$$?; rm -f \"$@\"; exit $${RV} )\n\n" in
   let cmxs_rules () = (* order is important here when there is foo.ml and foo.mllib *)
-    print "$(filter-out $(MLLIBFILES:.mllib=.cmxs),$(MLFILES:.ml=.cmxs) $(ML4FILES:.ml4=.cmxs) $(MLPACKFILES:.mlpack=.cmxs)): %.cmxs: %.cmx
-\t$(CAMLOPTLINK) $(ZDEBUG) $(ZFLAGS) -shared -o $@ $<\n\n";
-    print "$(MLLIBFILES:.mllib=.cmxs): %.cmxs: %.cmxa\n\t$(CAMLOPTLINK) $(ZDEBUG) $(ZFLAGS) -linkall -shared -o $@ $<\n\n" in
+    print "$(filter-out $(MLLIBFILES:.mllib=.cmxs),$(MLFILES:.ml=.cmxs) $(ML4FILES:.ml4=.cmxs) $(MLPACKFILES:.mlpack=.cmxs)): %.cmxs: %.cmx\n";
+    print "\t$(SHOW)'CAMLOPT -shared -o $@'\n";
+    print "\t$(HIDE)$(CAMLOPTLINK) $(ZDEBUG) $(ZFLAGS) -shared -o $@ $<\n\n";
+    print "$(MLLIBFILES:.mllib=.cmxs): %.cmxs: %.cmxa\n";
+    print "\t$(SHOW)'CAMLOPT -shared -o $@'\n";
+    print "\t$(HIDE)$(CAMLOPTLINK) $(ZDEBUG) $(ZFLAGS) -linkall -shared -o $@ $<\n\n"
+  in
   let mllib_rules () =
-    print "$(MLLIBFILES:.mllib=.cma): %.cma: | %.mllib\n\t$(CAMLLINK) $(ZDEBUG) $(ZFLAGS) -a -o $@ $^\n\n";
-    print "$(MLLIBFILES:.mllib=.cmxa): %.cmxa: | %.mllib\n\t$(CAMLOPTLINK) $(ZDEBUG) $(ZFLAGS) -a -o $@ $^\n\n";
+    print "$(MLLIBFILES:.mllib=.cma): %.cma: | %.mllib\n";
+    print "\t$(SHOW)'CAMLC -a -o $@'\n";
+    print "\t$(HIDE)$(CAMLLINK) $(ZDEBUG) $(ZFLAGS) -a -o $@ $^\n\n";
+    print "$(MLLIBFILES:.mllib=.cmxa): %.cmxa: | %.mllib\n";
+    print "\t$(SHOW)'CAMLOPT -a -o $@'\n";
+    print "\t$(HIDE)$(CAMLOPTLINK) $(ZDEBUG) $(ZFLAGS) -a -o $@ $^\n\n";
     print "$(addsuffix .d,$(MLLIBFILES)): %.mllib.d: %.mllib\n";
-    print "\t$(COQDEP) $(OCAMLLIBS) -c \"$<\" > \"$@\" || ( RV=$$?; rm -f \"$@\"; exit $${RV} )\n\n" in
+    print "\t$(SHOW)'COQDEP $<'\n";
+    print "\t$(HIDE)$(COQDEP) $(OCAMLLIBS) -c \"$<\" > \"$@\" || ( RV=$$?; rm -f \"$@\"; exit $${RV} )\n\n"
+  in
   let mlpack_rules () =
-    print "$(MLPACKFILES:.mlpack=.cmo): %.cmo: | %.mlpack\n\t$(CAMLLINK) $(ZDEBUG) $(ZFLAGS) -pack -o $@ $^\n\n";
-    print "$(MLPACKFILES:.mlpack=.cmx): %.cmx: | %.mlpack\n\t$(CAMLOPTLINK) $(ZDEBUG) $(ZFLAGS) -pack -o $@ $^\n\n";
+    print "$(MLPACKFILES:.mlpack=.cmo): %.cmo: | %.mlpack\n";
+    print "\t$(SHOW)'CAMLC -pack -o $@'\n";
+    print "\t$(HIDE)$(CAMLLINK) $(ZDEBUG) $(ZFLAGS) -pack -o $@ $^\n\n";
+    print "$(MLPACKFILES:.mlpack=.cmx): %.cmx: | %.mlpack\n";
+    print "\t$(SHOW)'CAMLOPT -pack -o $@'\n";
+    print "\t$(HIDE)$(CAMLOPTLINK) $(ZDEBUG) $(ZFLAGS) -pack -o $@ $^\n\n";
     print "$(addsuffix .d,$(MLPACKFILES)): %.mlpack.d: %.mlpack\n";
-    print "\t$(COQDEP) $(OCAMLLIBS) -c \"$<\" > \"$@\" || ( RV=$$?; rm -f \"$@\"; exit $${RV} )\n\n";
-in
+    print "\t$(SHOW)'COQDEP $<'\n";
+    print "\t$(HIDE)$(COQDEP) $(OCAMLLIBS) -c \"$<\" > \"$@\" || ( RV=$$?; rm -f \"$@\"; exit $${RV} )\n\n"
+  in
   let v_rules () =
-    print "$(VOFILES): %.vo: %.v\n\t$(COQC) $(COQDEBUG) $(COQFLAGS) $*\n\n";
-    print "$(GLOBFILES): %.glob: %.v\n\t$(COQC) $(COQDEBUG) $(COQFLAGS) $*\n\n";
-    print "$(VFILES:.v=.vio): %.vio: %.v\n\t$(COQC) -quick $(COQDEBUG) $(COQFLAGS) $*\n\n";
+    print "$(VOFILES): %.vo: %.v\n";
+    print "\t$(SHOW)COQC $<\n";
+    print "\t$(HIDE)$(COQC) $(COQDEBUG) $(COQFLAGS) $<\n\n";
+    print "$(GLOBFILES): %.glob: %.v\n\t$(COQC) $(COQDEBUG) $(COQFLAGS) $<\n\n";
+    print "$(VFILES:.v=.vio): %.vio: %.v\n\t$(COQC) -quick $(COQDEBUG) $(COQFLAGS) $<\n\n";
     print "$(GFILES): %.g: %.v\n\t$(GALLINA) $<\n\n";
     print "$(VFILES:.v=.tex): %.tex: %.v\n\t$(COQDOC) $(COQDOCFLAGS) -latex $< -o $@\n\n";
     print "$(HTMLFILES): %.html: %.v %.glob\n\t$(COQDOC) $(COQDOCFLAGS) -html $< -o $@\n\n";
     print "$(VFILES:.v=.g.tex): %.g.tex: %.v\n\t$(COQDOC) $(COQDOCFLAGS) -latex -g $< -o $@\n\n";
     print "$(GHTMLFILES): %.g.html: %.v %.glob\n\t$(COQDOC) $(COQDOCFLAGS)  -html -g $< -o $@\n\n";
     print "$(addsuffix .d,$(VFILES)): %.v.d: %.v\n";
-    print "\t$(COQDEP) $(COQLIBS) \"$<\" > \"$@\" || ( RV=$$?; rm -f \"$@\"; exit $${RV} )\n\n";
-    print "$(addsuffix .beautified,$(VFILES)): %.v.beautified:\n\t$(COQC) $(COQDEBUG) $(COQFLAGS) -beautify $*\n\n"
+    print "\t$(SHOW)'COQDEP $<'\n";
+    print "\t$(HIDE)$(COQDEP) $(COQLIBS) \"$<\" > \"$@\" || ( RV=$$?; rm -f \"$@\"; exit $${RV} )\n\n";
+    print "$(addsuffix .beautified,$(VFILES)): %.v.beautified:\n\t$(COQC) $(COQDEBUG) $(COQFLAGS) -beautify $*.v\n\n"
   in
     if !some_mlifile then mli_rules ();
     if !some_ml4file then ml4_rules ();
@@ -471,14 +528,15 @@ let variables is_install opt (args,defs) =
     print "CAMLOPTC?=$(OCAMLFIND) opt -c -rectypes -thread\n";
     print "CAMLLINK?=$(OCAMLFIND) ocamlc -rectypes -thread\n";
     print "CAMLOPTLINK?=$(OCAMLFIND) opt -rectypes -thread\n";
+    print "CAMLDEP?=$(OCAMLFIND) ocamldep -slash -ml-synonym .ml4 -ml-synonym .mlpack\n";
     print "CAMLLIB?=$(shell $(OCAMLFIND) printconf stdlib)\n";
     print "GRAMMARS?=grammar.cma\n";
     print "ifeq ($(CAMLP4),camlp5)
-CAMLP4EXTEND=pa_extend.cmo q_MLast.cmo pa_macro.cmo unix.cma threads.cma
+CAMLP4EXTEND=pa_extend.cmo q_MLast.cmo pa_macro.cmo
 else
-CAMLP4EXTEND=threads.cma
+CAMLP4EXTEND=
 endif\n";
-    print "PP?=-pp '$(CAMLP4O) -I $(CAMLLIB) -I $(CAMLLIB)/threads/ $(COQSRCLIBS) compat5.cmo \\
+    print "PP?=-pp '$(CAMLP4O) -I $(CAMLLIB) -I $(COQLIB)/grammar compat5.cmo \\
   $(CAMLP4EXTEND) $(GRAMMARS) $(CAMLP4OPTIONS) -impl'\n\n";
     end;
     match is_install with
@@ -515,39 +573,50 @@ let parameters () =
   print "# TIMECMD set a command to log .v compilation time;\n";
   print "# TIMED if non empty, use the default time command as TIMECMD;\n";
   print "# ZDEBUG/COQDEBUG to specify debug flags for ocamlc&ocamlopt/coqc;\n";
-  print "# DSTROOT to specify a prefix to install path.\n\n";
+  print "# DSTROOT to specify a prefix to install path.\n";
+  print "# VERBOSE to disable the short display of compilation rules.\n\n";
+  print "VERBOSE?=\n";
+  print "SHOW := $(if $(VERBOSE),@true \"\",@echo \"\")\n";
+  print "HIDE := $(if $(VERBOSE),,@)\n\n";
   print "# Here is a hack to make $(eval $(shell works:\n";
   print "define donewline\n\n\nendef\n";
   print "includecmdwithout@ = $(eval $(subst @,$(donewline),$(shell { $(1) | tr -d '\\r' | tr '\\n' '@'; })))\n";
   print "$(call includecmdwithout@,$(COQBIN)coqtop -config)\n\n";
-  print "TIMED?=\nTIMECMD?=\nSTDTIME=/usr/bin/time -f \"$* (user: %U mem: %M ko)\"\n";
+  print "TIMED?=\nTIMECMD?=\nSTDTIME?=/usr/bin/time -f \"$* (user: %U mem: %M ko)\"\n";
   print "TIMER=$(if $(TIMED), $(STDTIME), $(TIMECMD))\n\n";
   print "vo_to_obj = $(addsuffix .o,\\\n";
   print "  $(filter-out Warning: Error:,\\\n";
   print "  $(shell $(COQBIN)coqtop -q -noinit -batch -quiet -print-mod-uid $(1))))\n\n"
 
-let include_dirs (inc_ml,inc_i,inc_r) =
+let include_dirs (inc_ml,inc_q,inc_r) =
   let parse_ml_includes l = List.map (fun (x,_) -> "-I \"" ^ x ^ "\"") l in
-  let parse_includes l = List.map (fun (x,l,_) ->
-				   let l' = if l = "" then "\"\"" else l in
-				   "-Q \"" ^ x ^ "\" " ^ l' ^"") l in
-  let parse_rec_includes l = List.map (fun (p,l,_) ->
-				       let l' = if l = "" then "\"\"" else l in
-				       "-R \"" ^ p ^ "\" " ^ l' ^"") l in
+  let includes =
+    List.map (fun (p,l,_) ->
+              let l' = if l = "" then "\"\"" else l in
+              " \"" ^ p ^ "\" " ^ l' ^"") in
   let str_ml = parse_ml_includes inc_ml in
-  let str_i = parse_includes inc_i in
-  let str_r = parse_rec_includes inc_r in
-    section "Libraries definitions.";
-    if !some_ml4file || !some_mlfile || !some_mlifile then begin
-      print "OCAMLLIBS?="; print_list "\\\n  " str_ml; print "\n";
-    end;
-    if !some_vfile || !some_mllibfile || !some_mlpackfile then begin
-      print "COQLIBS?="; print_list "\\\n  " str_i;
-      List.iter (fun x -> print "\\\n  "; print x) str_r;
-      List.iter (fun x -> print "\\\n  "; print x) str_ml; print "\n";
-      print "COQDOCLIBS?="; print_list "\\\n  " str_i;
-      List.iter (fun x -> print "\\\n  "; print x) str_r; print "\n\n";
-    end
+  section "Libraries definitions.";
+  if !some_ml4file || !some_mlfile || !some_mlifile then begin
+    print "OCAMLLIBS?="; print_list "\\\n  " str_ml; print "\n";
+  end;
+  if !some_vfile || !some_mllibfile || !some_mlpackfile then begin
+    print "COQLIBS?=";
+    print_prefix_list "\\\n  -Q" (includes inc_q);
+    print_prefix_list "\\\n  -R" (includes inc_r);
+    print_prefix_list "\\\n  " str_ml;
+    print "\n";
+  end;
+  if !some_vfile then begin
+    print "COQCHKLIBS?=";
+    print_prefix_list "\\\n  -R" (includes inc_q);
+    print_prefix_list "\\\n  -R" (includes inc_r);
+    print "\n";
+    print "COQDOCLIBS?=";
+    print_prefix_list "\\\n  -R" (includes inc_q);
+    print_prefix_list "\\\n  -R" (includes inc_r);
+    print "\n";
+  end;
+  print "\n"
 
 let double_colon = ["clean"; "cleanall"; "archclean"]
 
@@ -578,10 +647,13 @@ let forpacks l =
   let () = if l <> [] then section "Ad-hoc implicit rules for mlpack." in
   List.iter (fun it ->
     let h = Filename.chop_extension it in
+    let pk = String.capitalize (Filename.basename h) in
     printf "$(addsuffix .cmx,$(filter $(basename $(MLFILES)),$(%s_MLPACK_DEPENDENCIES))): %%.cmx: %%.ml\n" h;
-    printf "\t$(CAMLOPTC) $(ZDEBUG) $(ZFLAGS) -for-pack %s $<\n\n" (String.capitalize (Filename.basename h));
+    printf "\t$(SHOW)'CAMLOPT -c -for-pack %s $<'\n" pk;
+    printf "\t$(HIDE)$(CAMLOPTC) $(ZDEBUG) $(ZFLAGS) -for-pack %s $<\n\n" pk;
     printf "$(addsuffix .cmx,$(filter $(basename $(ML4FILES)),$(%s_MLPACK_DEPENDENCIES))): %%.cmx: %%.ml4\n" h;
-    printf "\t$(CAMLOPTC) $(ZDEBUG) $(ZFLAGS) -for-pack %s $(PP) -impl $<\n\n" (String.capitalize (Filename.basename h))
+    printf "\t$(SHOW)'CAMLOPT -c -pp -for-pack %s $<'\n" pk;
+    printf "\t$(HIDE)$(CAMLOPTC) $(ZDEBUG) $(ZFLAGS) -for-pack %s $(PP) -impl $<\n\n" pk
   ) l
 
 let main_targets vfiles (mlifiles,ml4files,mlfiles,mllibfiles,mlpackfiles) other_targets inc =
@@ -720,7 +792,7 @@ let main_targets vfiles (mlifiles,ml4files,mlfiles,mllibfiles,mlpackfiles) other
       print "all-gal.pdf: $(VFILES)\n";
       print "\t$(COQDOC) -toc $(COQDOCFLAGS) -pdf -g $(COQDOCLIBS) -o $@ `$(COQDEP) -sort -suffix .v $^`\n\n";
       print "validate: $(VOFILES)\n";
-      print "\t$(COQCHK) $(COQCHKFLAGS) $(COQLIBS) $(notdir $(^:.vo=))\n\n";
+      print "\t$(COQCHK) $(COQCHKFLAGS) $(COQCHKLIBS) $(notdir $(^:.vo=))\n\n";
       print "beautify: $(VFILES:=.beautified)\n";
       print "\tfor file in $^; do mv $${file%.beautified} $${file%beautified}old && mv $${file} $${file%.beautified}; done\n";
       print "\t@echo \'Do not do \"make clean\" until you are sure that everything went well!\'\n";
@@ -773,22 +845,24 @@ let command_line args =
   print_list args;
   print "\n#\n\n"
 
-let ensure_root_dir (v,(mli,ml4,ml,mllib,mlpack),_,_) ((ml_inc,i_inc,r_inc) as l) =
+let ensure_root_dir (vfiles,(mlis,ml4s,mls,mllibs,mlpacks),_,_) inc =
+  let (ml_inc,i_inc,r_inc) = inc in
   let here = Sys.getcwd () in
-  let not_tops =List.for_all (fun s -> s <> Filename.basename s) in
+  let not_tops =  List.for_all (fun s -> s <> Filename.basename s) in
   if List.exists (fun (_,_,x) -> x = here) i_inc
     || List.exists (fun (_,_,x) -> is_prefix x here) r_inc
-    || (not_tops v && not_tops mli && not_tops ml4 && not_tops ml
-	&& not_tops mllib && not_tops mlpack) then
-    l
+    || (not_tops vfiles && not_tops mlis && not_tops ml4s && not_tops mls
+	&& not_tops mllibs && not_tops mlpacks)
+  then
+    inc
   else
     ((".",here)::ml_inc,i_inc,(".","Top",here)::r_inc)
 
-let warn_install_at_root_directory
-    (vfiles,(mlifiles,ml4files,mlfiles,mllibfiles,mlpackfiles),_,_) (inc_ml,inc_i,inc_r) =
+let warn_install_at_root_directory (vfiles,(mlis,ml4s,mls,mllibs,mlpacks),_,_) inc =
+  let (inc_ml,inc_i,inc_r) = inc in
   let inc_top = List.filter (fun (_,ldir,_) -> ldir = "") (inc_r@inc_i) in
   let inc_top_p = List.map (fun (p,_,_) -> p) inc_top in
-  let files = vfiles @ mlifiles @ ml4files @ mlfiles @ mllibfiles @ mlpackfiles in
+  let files = vfiles @ mlis @ ml4s @ mls @ mllibs @ mlpacks in
   if List.exists (fun f -> List.mem (Filename.dirname f) inc_top_p) files
   then
     Printf.eprintf "Warning: install target will copy files at the first level of the coq contributions installation directory; option -R or -Q %sis recommended\n"
@@ -813,7 +887,7 @@ let merlin targets (ml_inc,_,_) =
   print ".merlin:\n";
   print "\t@echo 'FLG -rectypes' > .merlin\n" ;
   List.iter (fun c ->
-      printf "\t@echo \"B $(COQLIB) %s\" >> .merlin\n" c)
+      printf "\t@echo \"B $(COQLIB)%s\" >> .merlin\n" c)
     lib_dirs ;
   List.iter (fun (_,c) ->
       printf "\t@echo \"B %s\" >> .merlin\n" c;
@@ -826,7 +900,9 @@ let do_makefile args =
     |[] -> var := false
     |_::_ -> var := true in
   let (project_file,makefile,is_install,opt),l =
-    try Project_file.process_cmd_line Filename.current_dir_name (None,None,Project_file.UnspecInstall,true) [] args
+    try
+      Project_file.process_cmd_line Filename.current_dir_name
+       (None,None,Project_file.UnspecInstall,true) [] args
     with Project_file.Parsing_error -> usage () in
   let (v_f,(mli_f,ml4_f,ml_f,mllib_f,mlpack_f),sps,sds as targets), inc, defs =
     Project_file.split_arguments l in
@@ -850,7 +926,9 @@ let do_makefile args =
     List.iter check_dep (Str.split (Str.regexp "[ \t]+") dependencies)) sps;
 
   let inc = ensure_root_dir targets inc in
-  if is_install <> Project_file.NoInstall then warn_install_at_root_directory targets inc;
+  if is_install <> Project_file.NoInstall then begin
+    warn_install_at_root_directory targets inc;
+  end;
   check_overlapping_include inc;
   banner ();
   header_includes ();
diff --git a/tools/coqc.ml b/tools/coqc.ml
index f957200ab..b12d48710 100644
--- a/tools/coqc.ml
+++ b/tools/coqc.ml
@@ -88,13 +88,12 @@ let parse_args () =
 
 (* Options for coqtop : a) options with 0 argument *)
 
-    | ("-notactics"|"-bt"|"-debug"|"-nolib"|"-boot"|"-time"
+    | ("-notactics"|"-bt"|"-debug"|"-nolib"|"-boot"|"-time"|"-profile-ltac"
       |"-batch"|"-noinit"|"-nois"|"-noglob"|"-no-glob"
       |"-q"|"-full"|"-profile"|"-just-parsing"|"-echo" |"-unsafe"|"-quiet"
       |"-silent"|"-m"|"-xml"|"-v7"|"-v8"|"-beautify"|"-strict-implicit"
       |"-dont-load-proofs"|"-load-proofs"|"-force-load-proofs"
       |"-impredicative-set"|"-vm"|"-native-compiler"
-      |"-verbose-compat-notations"|"-no-compat-notations"
       |"-indices-matter"|"-quick"|"-type-in-type"
       |"-async-proofs-always-delegate"|"-async-proofs-never-reopen-branch"
       as o) :: rem ->
@@ -107,6 +106,7 @@ let parse_args () =
       |"-load-ml-source"|"-require"|"-load-ml-object"
       |"-init-file"|"-dump-glob"|"-compat"|"-coqlib"|"-top"
       |"-async-proofs-j" |"-async-proofs-private-flags" |"-async-proofs" |"-w"
+      |"-o"|"-profile-ltac-cutoff" 
       as o) :: rem ->
 	begin
 	  match rem with
diff --git a/tools/coqdep.ml b/tools/coqdep.ml
index 9886b263c..a9f1b7376 100644
--- a/tools/coqdep.ml
+++ b/tools/coqdep.ml
@@ -495,7 +495,7 @@ let coqdep () =
     add_rec_dir_import (fun _ -> add_caml_known) "theories" ["Coq"];
     add_rec_dir_import (fun _ -> add_caml_known) "plugins" ["Coq"];
   end else begin
-    Envars.set_coqlib ~fail:Errors.error;
+    Envars.set_coqlib ~fail:CErrors.error;
     let coqlib = Envars.coqlib () in
     add_rec_dir_import add_coqlib_known (coqlib//"theories") ["Coq"];
     add_rec_dir_import add_coqlib_known (coqlib//"plugins") ["Coq"];
@@ -525,6 +525,6 @@ let coqdep () =
 let _ =
   try
     coqdep ()
-  with Errors.UserError(s,p) ->
-    let pp = if s <> "_" then Pp.(str s ++ str ": " ++ p) else p in
+  with CErrors.UserError(s,p) ->
+    let pp = (match s with | None -> p | Some s -> Pp.(str s ++ str ": " ++ p))  in
     Feedback.msg_error pp
diff --git a/tools/coqdep_common.ml b/tools/coqdep_common.ml
index 0f7937d72..0064aebda 100644
--- a/tools/coqdep_common.ml
+++ b/tools/coqdep_common.ml
@@ -445,7 +445,7 @@ let mL_dependencies () =
        let efullname = escape fullname in
        printf "%s_MLLIB_DEPENDENCIES:=%s\n" efullname dep;
        printf "%s.cma:$(addsuffix .cmo,$(%s_MLLIB_DEPENDENCIES))\n" efullname efullname;
-       printf "%s.cmxa %s.cmxs:$(addsuffix .cmx,$(%s_MLLIB_DEPENDENCIES))\n" efullname efullname efullname;
+       printf "%s.cmxa:$(addsuffix .cmx,$(%s_MLLIB_DEPENDENCIES))\n" efullname efullname;
        flush stdout)
     (List.rev !mllibAccu);
   List.iter
@@ -455,7 +455,7 @@ let mL_dependencies () =
        let efullname = escape fullname in
        printf "%s_MLPACK_DEPENDENCIES:=%s\n" efullname dep;
        printf "%s.cmo:$(addsuffix .cmo,$(%s_MLPACK_DEPENDENCIES))\n" efullname efullname;
-       printf "%s.cmx %s.cmxs:$(addsuffix .cmx,$(%s_MLPACK_DEPENDENCIES))\n" efullname efullname efullname;
+       printf "%s.cmx:$(addsuffix .cmx,$(%s_MLPACK_DEPENDENCIES))\n" efullname efullname;
        flush stdout)
     (List.rev !mlpackAccu)
 
@@ -526,7 +526,6 @@ let rec add_directory recur add_file phys_dir log_dir =
     | FileRegular f ->
         add_file phys_dir log_dir f
   in
-  check_unix_dir (fun s -> eprintf "*** Warning: %s\n" s) phys_dir;
   if exists_dir phys_dir then
     process_directory f phys_dir
   else
diff --git a/tools/coqdoc/cpretty.mll b/tools/coqdoc/cpretty.mll
index 81c01f29d..919f37b91 100644
--- a/tools/coqdoc/cpretty.mll
+++ b/tools/coqdoc/cpretty.mll
@@ -239,6 +239,12 @@
     let s = String.sub s isp (String.length s - isp) in
     Output.keyword s (lexeme_start lexbuf + isp)
 
+  let only_gallina () =
+    !Cdglobals.gallina && !in_proof <> None
+
+  let parse_comments () =
+    !Cdglobals.parse_comments && not (only_gallina ())
+
 }
 
 (*s Regular expressions *)
@@ -480,7 +486,7 @@ rule coq_bol = parse
 	in if eol then coq_bol lexbuf else coq lexbuf }
   | space* end_kw {
       let eol =
-	if not (!in_proof <> None && !Cdglobals.gallina) then
+	if not (only_gallina ()) then
 	  begin backtrack lexbuf; body_bol lexbuf end
 	else skip_to_dot lexbuf
       in
@@ -529,14 +535,15 @@ rule coq_bol = parse
 	coq_bol lexbuf }
   | space* "(*"
       { comment_level := 1;
-	if !Cdglobals.parse_comments then begin
-	  let s = lexeme lexbuf in
-	  let nbsp,isp = count_spaces s in
-	    Output.indentation nbsp;
-	    Output.start_comment ();
-	end;
-	let eol = comment lexbuf in
-	  if eol then coq_bol lexbuf else coq lexbuf }
+        let eol =
+          if parse_comments () then begin
+            let s = lexeme lexbuf in
+            let nbsp, isp = count_spaces s in
+            Output.indentation nbsp;
+            Output.start_comment ();
+            comment lexbuf
+          end else skipped_comment lexbuf in
+        if eol then coq_bol lexbuf else coq lexbuf }
   | eof
       { () }
   | _
@@ -544,7 +551,7 @@ rule coq_bol = parse
 	  if not !Cdglobals.gallina then
 	    begin backtrack lexbuf; body_bol lexbuf end
 	  else
-	    skip_to_dot lexbuf
+	    skip_to_dot_or_brace lexbuf
 	in
 	  if eol then coq_bol lexbuf else coq lexbuf }
 
@@ -552,7 +559,7 @@ rule coq_bol = parse
 
 and coq = parse
   | nl
-      { if not (!in_proof <> None && !Cdglobals.gallina) then Output.line_break(); coq_bol lexbuf }
+      { if not (only_gallina ()) then Output.line_break(); coq_bol lexbuf }
   | "(**" space_nl
       { Output.end_coq (); Output.start_doc ();
 	let eol = doc_bol lexbuf in
@@ -560,16 +567,12 @@ and coq = parse
 	  if eol then coq_bol lexbuf else coq lexbuf }
   | "(*"
       { comment_level := 1;
-	if !Cdglobals.parse_comments then begin
-	  let s = lexeme lexbuf in
-	  let nbsp,isp = count_spaces s in
-	    Output.indentation nbsp;
-	    Output.start_comment ();
-	end;
-	let eol = comment lexbuf in
-	  if eol then coq_bol lexbuf
-          else coq lexbuf
-      }
+        let eol =
+          if parse_comments () then begin
+            Output.start_comment ();
+            comment lexbuf
+          end else skipped_comment lexbuf in
+        if eol then coq_bol lexbuf else coq lexbuf }
   | nl+ space* "]]"
       { if not !formatted then
 	begin
@@ -644,7 +647,7 @@ and coq = parse
 	  if not !Cdglobals.gallina then
 	    begin backtrack lexbuf; body lexbuf end
 	  else
-	    skip_to_dot lexbuf
+	    skip_to_dot_or_brace lexbuf
 	in
 	  if eol then coq_bol lexbuf else coq lexbuf}
 
@@ -672,7 +675,7 @@ and doc_bol = parse
         in
           match check_start_list line with
           | Neither -> backtrack_past_newline lexbuf; doc None lexbuf
-          | List n -> Output.paragraph ();
+          | List n -> if lines > 0 then Output.paragraph ();
                       Output.item 1; doc (Some [n]) lexbuf
           | Rule -> Output.rule (); doc None lexbuf
       }
@@ -733,24 +736,7 @@ and doc_list_bol indents = parse
         in
         let (n_spaces,_) = count_spaces buf in
         match find_level indents n_spaces with
-        | InLevel _ ->
-            Output.paragraph ();
-            backtrack_past_newline lexbuf;
-            doc_list_bol indents lexbuf
-        | StartLevel n ->
-            if n = 1 then
-              begin
-                Output.stop_item ();
-                backtrack_past_newline lexbuf;
-                doc_bol lexbuf
-              end
-            else
-              begin
-                Output.paragraph ();
-                backtrack_past_newline lexbuf;
-                doc_list_bol indents lexbuf
-              end
-        | Before -> 
+        | StartLevel 1 | Before ->
         (* Here we were at the beginning of a line, and it was blank.
            The next line started before any list items.  So: insert
            a paragraph for the empty line, rewind to whatever's just
@@ -760,6 +746,10 @@ and doc_list_bol indents = parse
             Output.paragraph ();
             backtrack_past_newline lexbuf;
             doc_bol lexbuf
+        | StartLevel _ | InLevel _ ->
+            Output.paragraph ();
+            backtrack_past_newline lexbuf;
+            doc_list_bol indents lexbuf
 
       }
   | space* _
@@ -768,10 +758,7 @@ and doc_list_bol indents = parse
         | Before -> Output.stop_item (); backtrack lexbuf;
                     doc_bol lexbuf
         | StartLevel n ->
-            (if n = 1 then
-               Output.stop_item ()
-             else
-               Output.reach_item_level (n-1));
+            Output.reach_item_level (n-1);
             backtrack lexbuf;
             doc (Some (take (n-1) indents)) lexbuf
         | InLevel (n,_) ->
@@ -814,9 +801,10 @@ and doc indents = parse
                         | Some is -> doc_list_bol is
                         | None   -> doc_bol
         in
-        let eol = comment lexbuf in
-          if eol then bol_parse lexbuf else doc indents lexbuf
-      }
+        let eol =
+          if !Cdglobals.parse_comments then comment lexbuf
+          else skipped_comment lexbuf in
+        if eol then bol_parse lexbuf else doc indents lexbuf }
   | '*'* "*)" space_nl* "(**"
       {(match indents with
         | Some _ -> Output.stop_item ()
@@ -935,7 +923,9 @@ and escaped_coq = parse
         Output.sublexer_in_doc '['; escaped_coq lexbuf }
   | "(*"
       { Tokens.flush_sublexer (); comment_level := 1;
-        ignore (comment lexbuf); escaped_coq lexbuf }
+        ignore (if !Cdglobals.parse_comments then comment lexbuf
+                else skipped_comment lexbuf);
+        escaped_coq lexbuf }
   | "*)"
       { (* likely to be a syntax error: we escape *) backtrack lexbuf }
   | eof
@@ -975,76 +965,101 @@ and comments = parse
   | _
       { Output.char (lexeme_char lexbuf 0); comments lexbuf }
 
-(*s Skip comments *)
+and skipped_comment = parse
+  | "(*"
+      { incr comment_level;
+	skipped_comment lexbuf }
+  | "*)" space* nl
+      { decr comment_level;
+        if !comment_level > 0 then skipped_comment lexbuf else true }
+  | "*)"
+      { decr comment_level;
+        if !comment_level > 0 then skipped_comment lexbuf else false }
+  | eof { false }
+  | _ { skipped_comment lexbuf }
 
 and comment = parse
-  | "(*" { incr comment_level;
-	   if !Cdglobals.parse_comments then Output.start_comment ();
-	   comment lexbuf }
-  | "*)" space* nl {
-      if !Cdglobals.parse_comments then
-	(Output.end_comment (); Output.line_break ());
-      decr comment_level; if !comment_level > 0 then comment lexbuf else true }
-  | "*)" {
-      if !Cdglobals.parse_comments then (Output.end_comment ());
-      decr comment_level; if !comment_level > 0 then comment lexbuf else false }
-  | "[" {
-      if !Cdglobals.parse_comments then
-	if !Cdglobals.plain_comments then Output.char '['
+  | "(*"
+      { incr comment_level;
+        Output.start_comment ();
+        comment lexbuf }
+  | "*)" space* nl
+      { Output.end_comment ();
+        Output.line_break ();
+        decr comment_level;
+        if !comment_level > 0 then comment lexbuf else true }
+  | "*)"
+      { Output.end_comment ();
+        decr comment_level;
+        if !comment_level > 0 then comment lexbuf else false }
+  | "["
+      { if !Cdglobals.plain_comments then Output.char '['
         else (brackets := 1; Output.start_inline_coq ();
               escaped_coq lexbuf; Output.end_inline_coq ());
-      comment lexbuf }
-  | "[[" nl {
-      if !Cdglobals.parse_comments then
-        if !Cdglobals.plain_comments then (Output.char '['; Output.char '[')
+        comment lexbuf }
+  | "[[" nl
+      { if !Cdglobals.plain_comments then (Output.char '['; Output.char '[')
         else (formatted := true;
               Output.start_inline_coq_block ();
               let _ = body_bol lexbuf in
                 Output.end_inline_coq_block (); formatted := false);
-      comment lexbuf}
+        comment lexbuf }
   | "$"
-      { if !Cdglobals.parse_comments then
-          if !Cdglobals.plain_comments then Output.char '$'
-          else (Output.start_latex_math (); escaped_math_latex lexbuf);
+      { if !Cdglobals.plain_comments then Output.char '$'
+        else (Output.start_latex_math (); escaped_math_latex lexbuf);
         comment lexbuf }
   | "$$"
-      { if !Cdglobals.parse_comments
-        then
-          (if !Cdglobals.plain_comments then Output.char '$'; Output.char '$');
-        doc None lexbuf }
+      { if !Cdglobals.plain_comments then Output.char '$';
+        Output.char '$';
+        comment lexbuf }
   | "%"
-      { if !Cdglobals.parse_comments
-          then
-            if !Cdglobals.plain_comments then Output.char '%'
-            else escaped_latex lexbuf; comment lexbuf }
+      { if !Cdglobals.plain_comments then Output.char '%'
+        else escaped_latex lexbuf;
+        comment lexbuf }
   | "%%"
-      { if !Cdglobals.parse_comments
-        then
-          (if !Cdglobals.plain_comments then Output.char '%'; Output.char '%');
+      { if !Cdglobals.plain_comments then Output.char '%';
+        Output.char '%';
         comment lexbuf }
   | "#"
-      { if !Cdglobals.parse_comments
-        then
-          if !Cdglobals.plain_comments then Output.char '$'
-          else escaped_html lexbuf; comment lexbuf }
+      { if !Cdglobals.plain_comments then Output.char '#'
+        else escaped_html lexbuf;
+        comment lexbuf }
   | "##"
-      { if !Cdglobals.parse_comments
-        then
-          (if !Cdglobals.plain_comments then Output.char '#'; Output.char '#');
+      { if !Cdglobals.plain_comments then Output.char '#';
+        Output.char '#';
         comment lexbuf }
   | eof  { false }
-  | space+ { if !Cdglobals.parse_comments
-             then Output.indentation (fst (count_spaces (lexeme lexbuf)));
-             comment lexbuf }
-  | nl   { if !Cdglobals.parse_comments
-           then Output.line_break (); comment lexbuf }
-  | _    { if !Cdglobals.parse_comments then Output.char (lexeme_char lexbuf 0);
-           comment lexbuf }
+  | space+
+      { Output.indentation (fst (count_spaces (lexeme lexbuf)));
+        comment lexbuf }
+  | nl
+      { Output.line_break ();
+        comment lexbuf }
+  | _ { Output.char (lexeme_char lexbuf 0);
+        comment lexbuf }
 
 and skip_to_dot = parse
   | '.' space* nl { true }
   | eof | '.' space+ { false }
-  | "(*" { comment_level := 1; ignore (comment lexbuf); skip_to_dot lexbuf }
+  | "(*"
+      { comment_level := 1;
+        ignore (skipped_comment lexbuf);
+        skip_to_dot lexbuf }
+  | _ { skip_to_dot lexbuf }
+
+and skip_to_dot_or_brace = parse
+  | '.' space* nl { true }
+  | eof | '.' space+ { false }
+  | "(*"
+      { comment_level := 1;
+        ignore (skipped_comment lexbuf);
+        skip_to_dot_or_brace lexbuf }
+  | "}" space* nl
+      { true }
+  | "}"
+      { false }
+  | space*
+      { skip_to_dot_or_brace lexbuf }
   | _ { skip_to_dot lexbuf }
 
 and body_bol = parse
@@ -1114,12 +1129,18 @@ and body = parse
 	let eol = doc_bol lexbuf in
 	  Output.end_doc (); Output.start_coq ();
 	  if eol then body_bol lexbuf else body lexbuf }
-  | "(*" { Tokens.flush_sublexer(); comment_level := 1;
-	   if !Cdglobals.parse_comments then Output.start_comment ();
-	   let eol = comment lexbuf in
-	     if eol
-	     then begin if not !Cdglobals.parse_comments then Output.line_break(); body_bol lexbuf end
-	     else body lexbuf }
+  | "(*"
+      { Tokens.flush_sublexer(); comment_level := 1;
+        let eol =
+          if parse_comments () then begin
+            Output.start_comment ();
+            comment lexbuf
+          end else begin
+            let eol = skipped_comment lexbuf in
+            if eol then Output.line_break();
+            eol
+          end in
+	if eol then body_bol lexbuf else body lexbuf }
   | "where" 
       { Tokens.flush_sublexer();
         Output.ident (lexeme lexbuf) None;
diff --git a/tools/coqmktop.ml b/tools/coqmktop.ml
index 6f3d8e2b8..645b3665e 100644
--- a/tools/coqmktop.ml
+++ b/tools/coqmktop.ml
@@ -75,6 +75,7 @@ let std_includes basedir =
   let rebase d = match basedir with None -> d | Some base -> base / d in
   ["-I"; rebase ".";
    "-I"; rebase "lib";
+   "-I"; rebase "vernac";       (* For Mltop *)
    "-I"; rebase "toplevel";
    "-I"; rebase "kernel/byterun";
    "-I"; Envars.camlp4lib () ] @
@@ -235,7 +236,7 @@ let declare_loading_string () =
 \n     Mltop.set_top\
 \n       {Mltop.load_obj=\
 \n         (fun f -> if not (Topdirs.load_file ppf f)\
-\n                   then Errors.error (\"Could not load plugin \"^f));\
+\n                   then CErrors.error (\"Could not load plugin \"^f));\
 \n        Mltop.use_file=Topdirs.dir_use ppf;\
 \n        Mltop.add_dir=Topdirs.dir_directory;\
 \n        Mltop.ml_loop=(fun () -> Toploop.loop ppf) };;\
@@ -265,7 +266,7 @@ let create_tmp_main_file modules =
 let main () =
   let (options, userfiles) = parse_args () in
   (* Directories: *)
-  let () = Envars.set_coqlib ~fail:Errors.error in
+  let () = Envars.set_coqlib ~fail:CErrors.error in
   let basedir = if !Flags.boot then None else Some (Envars.coqlib ()) in
   (* Which ocaml compiler to invoke *)
   let prog = if !opt then "opt" else "ocamlc" in
diff --git a/tools/fake_ide.ml b/tools/fake_ide.ml
index d5ef807b6..8fcca535d 100644
--- a/tools/fake_ide.ml
+++ b/tools/fake_ide.ml
@@ -28,7 +28,8 @@ let error_xml s =
   Printf.eprintf "fake_id: error: %a\n%!" print_xml s;
   exit 1
 
-let logger level content = Printf.eprintf "%a\n%! " print_xml content
+let logger level content =
+  Printf.eprintf "%a\n%! " print_xml (Richpp.repr content)
 
 let base_eval_call ?(print=true) ?(fail=true) call coqtop =
   if print then prerr_endline (Xmlprotocol.pr_call call);
@@ -36,15 +37,14 @@ let base_eval_call ?(print=true) ?(fail=true) call coqtop =
   Xml_printer.print coqtop.xml_printer xml_query;
   let rec loop () =
     let xml = Xml_parser.parse coqtop.xml_parser in
-    if Feedback.is_message xml then
-      let message = Feedback.to_message xml in
-      let level = message.Feedback.message_level in
-      let content = message.Feedback.message_content in
+    match Xmlprotocol.is_message xml with
+    | Some (level, _loc, content) ->
       logger level content;
       loop ()
-    else if Feedback.is_feedback xml then
-      loop ()
-    else (Xmlprotocol.to_answer call xml)
+    | None ->
+      if Xmlprotocol.is_feedback xml then
+        loop ()
+      else Xmlprotocol.to_answer call xml
   in
   let res = loop () in
   if print then prerr_endline (Xmlprotocol.pr_full_value call res);
diff --git a/tools/ocamllibdep.mll b/tools/ocamllibdep.mll
index 670ff487c..bf82be09f 100644
--- a/tools/ocamllibdep.mll
+++ b/tools/ocamllibdep.mll
@@ -33,10 +33,6 @@ rule mllib_list = parse
 open Printf
 open Unix
 
-(** [coqdep_boot] is a stripped-down version of [coqdep] used to treat
-    with mllib files.
-*)
-
 (* Makefile's escaping rules are awful: $ is escaped by doubling and
    other special characters are escaped by backslash prefixing while
    backslashes themselves must be escaped only if part of a sequence
@@ -132,6 +128,7 @@ let add_ml_known, search_ml_known = mkknown ()
 let add_mlpack_known, search_mlpack_known = mkknown ()
 
 let mllibAccu = ref ([] : (string * dir) list)
+let mlpackAccu = ref ([] : (string * dir) list)
 
 let add_caml_known phys_dir f =
   let basename,suff = get_extension f [".ml";".ml4";".mlpack"] in
@@ -148,18 +145,15 @@ let traite_fichier_modules md ext =
     let chan = open_in (md ^ ext) in
     let list = mllib_list (Lexing.from_channel chan) in
     List.fold_left
-      (fun a_faire str -> match search_mlpack_known str with
-	| Some mldir ->
-	  let file = file_name str mldir in
-	  a_faire^" "^file
-	| None ->
+      (fun acc str ->
+       match search_mlpack_known str with
+       | Some mldir -> (file_name str mldir) :: acc
+       | None ->
 	  match search_ml_known str with
-	    | Some mldir ->
-	      let file = file_name str mldir in
-	      a_faire^" "^file
-	    | None -> a_faire) "" list
+	  | Some mldir -> (file_name str mldir) :: acc
+	  | None -> acc) [] (List.rev list)
   with
-    | Sys_error _ -> ""
+    | Sys_error _ -> []
     | Syntax_error (i,j) -> error_cannot_parse (md^ext) (i,j)
 
 let addQueue q v = q := v :: !q
@@ -167,22 +161,43 @@ let addQueue q v = q := v :: !q
 let treat_file old_name =
   let name = Filename.basename old_name in
   let dirname = Some (Filename.dirname old_name) in
-  match get_extension name [".mllib"] with
+  match get_extension name [".mllib";".mlpack"] with
   | (base,".mllib") -> addQueue mllibAccu (base,dirname)
+  | (base,".mlpack") -> addQueue mlpackAccu (base,dirname)
   | _ -> ()
 
 let mllib_dependencies () =
   List.iter
     (fun (name,dirname) ->
        let fullname = file_name name dirname in
-       let dep = traite_fichier_modules fullname ".mllib" in
+       let deps = traite_fichier_modules fullname ".mllib" in
+       let sdeps = String.concat " " deps in
        let efullname = escape fullname in
-       printf "%s_MLLIB_DEPENDENCIES:=%s\n" efullname dep;
-       printf "%s.cma:$(addsuffix .cmo,$(%s_MLLIB_DEPENDENCIES))\n" efullname efullname;
-       printf "%s.cmxa %s.cmxs:$(addsuffix .cmx,$(%s_MLLIB_DEPENDENCIES))\n" efullname efullname efullname;
+       printf "%s_MLLIB_DEPENDENCIES:=%s\n" efullname sdeps;
+       printf "%s.cma:$(addsuffix .cmo,$(%s_MLLIB_DEPENDENCIES))\n"
+         efullname efullname;
+       printf "%s.cmxa:$(addsuffix .cmx,$(%s_MLLIB_DEPENDENCIES))\n"
+         efullname efullname;
        flush Pervasives.stdout)
     (List.rev !mllibAccu)
 
+let mlpack_dependencies () =
+  List.iter
+    (fun (name,dirname) ->
+       let fullname = file_name name dirname in
+       let modname = String.capitalize name in
+       let deps = traite_fichier_modules fullname ".mlpack" in
+       let sdeps = String.concat " " deps in
+       let efullname = escape fullname in
+       printf "%s_MLPACK_DEPENDENCIES:=%s\n" efullname sdeps;
+       List.iter (fun d -> printf "%s_FORPACK:= -for-pack %s\n" d modname) deps;
+       printf "%s.cmo:$(addsuffix .cmo,$(%s_MLPACK_DEPENDENCIES))\n"
+         efullname efullname;
+       printf "%s.cmx:$(addsuffix .cmx,$(%s_MLPACK_DEPENDENCIES))\n"
+         efullname efullname;
+       flush Pervasives.stdout)
+    (List.rev !mlpackAccu)
+
 let rec parse = function
   | "-I" :: r :: ll ->
        (* To solve conflict (e.g. same filename in kernel and checker)
@@ -192,10 +207,11 @@ let rec parse = function
   | f :: ll -> treat_file f; parse ll
   | [] -> ()
 
-let coqdep_boot () =
+let main () =
   if Array.length Sys.argv < 2 then exit 1;
   parse (List.tl (Array.to_list Sys.argv));
-  mllib_dependencies ()
+  mllib_dependencies ();
+  mlpack_dependencies ()
 
-let _ = Printexc.catch coqdep_boot ()
+let _ = Printexc.catch main ()
 }
diff --git a/toplevel/coqinit.ml b/toplevel/coqinit.ml
index 65c5917b7..98f60924b 100644
--- a/toplevel/coqinit.ml
+++ b/toplevel/coqinit.ml
@@ -51,7 +51,7 @@ let load_rcfile() =
 			 " found. Skipping rcfile loading."))
 	*)
     with reraise ->
-      let reraise = Errors.push reraise in
+      let reraise = CErrors.push reraise in
       let () = Feedback.msg_info (str"Load of rcfile failed.") in
       iraise reraise
   else
@@ -59,13 +59,12 @@ let load_rcfile() =
 
 (* Recursively puts dir in the LoadPath if -nois was not passed *)
 let add_stdlib_path ~unix_path ~coq_root ~with_ml =
-  Mltop.add_rec_path ~unix_path ~coq_root ~implicit:(!Flags.load_init);
-  if with_ml then
-    Mltop.add_rec_ml_dir unix_path
+  let add_ml = if with_ml then Mltop.AddRecML else Mltop.AddNoML in
+  Mltop.add_rec_path add_ml ~unix_path ~coq_root ~implicit:(!Flags.load_init)
 
 let add_userlib_path ~unix_path =
-  Mltop.add_rec_path ~unix_path ~coq_root:Nameops.default_root_prefix ~implicit:false;
-  Mltop.add_rec_ml_dir unix_path
+  Mltop.add_rec_path Mltop.AddRecML ~unix_path
+    ~coq_root:Nameops.default_root_prefix ~implicit:false
 
 (* Options -I, -I-as, and -R of the command line *)
 let includes = ref []
@@ -90,7 +89,8 @@ let init_load_path () =
       Mltop.add_ml_dir (coqlib/"stm");
       Mltop.add_ml_dir (coqlib/"ide")
     end;
-    Mltop.add_ml_dir (coqlib/"toploop");
+    if System.exists_dir (coqlib/"toploop") then
+      Mltop.add_ml_dir (coqlib/"toploop");
     (* then standard library *)
     add_stdlib_path ~unix_path:(coqlib/"theories") ~coq_root ~with_ml:false;
     (* then plugins *)
@@ -108,7 +108,7 @@ let init_load_path () =
     (* additional loadpath, given with options -Q and -R *)
     List.iter
       (fun (unix_path, coq_root, implicit) ->
-        Mltop.add_rec_path ~unix_path ~coq_root ~implicit)
+        Mltop.add_rec_path Mltop.AddNoML ~unix_path ~coq_root ~implicit)
       (List.rev !includes);
     (* additional ml directories, given with option -I *)
     List.iter Mltop.add_ml_dir (List.rev !ml_includes)
@@ -130,11 +130,14 @@ let init_ocaml_path () =
         [ "grammar" ]; [ "ide" ]; [ "ltac" ]; ]
 
 let get_compat_version = function
-  | "8.5" -> Flags.Current
+  | "8.7" -> Flags.Current
+  | "8.6" -> Flags.V8_6
+  | "8.5" -> Flags.V8_5
   | "8.4" -> Flags.V8_4
   | "8.3" -> Flags.V8_3
   | "8.2" -> Flags.V8_2
   | ("8.1" | "8.0") as s ->
-    Feedback.msg_warning (str "Compatibility with version " ++ str s ++ str " not supported.");
-    Flags.V8_2
-  | s -> Errors.errorlabstrm "get_compat_version" (str "Unknown compatibility version \"" ++ str s ++ str "\".")
+    CErrors.user_err ~hdr:"get_compat_version"
+      (str "Compatibility with version " ++ str s ++ str " not supported.")
+  | s -> CErrors.user_err ~hdr:"get_compat_version"
+      (str "Unknown compatibility version \"" ++ str s ++ str "\".")
diff --git a/toplevel/coqloop.ml b/toplevel/coqloop.ml
index c8879963e..e9771cfa4 100644
--- a/toplevel/coqloop.ml
+++ b/toplevel/coqloop.ml
@@ -7,13 +7,13 @@
 (************************************************************************)
 
 open Pp
-open Errors
+open CErrors
 open Util
 open Flags
 open Vernac
 open Pcoq
 
-let top_stderr x = msg_with !Pp_control.err_ft x
+let top_stderr x = msg_with ~pp_tag:Ppstyle.pp_tag !Pp_control.err_ft x
 
 (* A buffer for the character read from a channel. We store the command
  * entered to be able to report errors without pretty-printing. *)
@@ -23,7 +23,7 @@ type input_buffer = {
   mutable str : string; (* buffer of already read characters *)
   mutable len : int;    (* number of chars in the buffer *)
   mutable bols : int list; (* offsets in str of beginning of lines *)
-  mutable tokens : Gram.parsable; (* stream of tokens *)
+  mutable tokens : Gram.coq_parsable; (* stream of tokens *)
   mutable start : int } (* stream count of the first char of the buffer *)
 
 (* Double the size of the buffer. *)
@@ -34,7 +34,7 @@ let resize_buffer ibuf =
   ibuf.str <- nstr
 
 (* Delete all irrelevant lines of the input buffer. Keep the last line
-   in the buffer (useful when there are several commands on the same line. *)
+   in the buffer (useful when there are several commands on the same line). *)
 
 let resynch_buffer ibuf =
   match ibuf.bols with
@@ -146,44 +146,23 @@ let print_highlight_location ib loc =
                       str sn ++ str dn) in
 	  (l1 ++ li ++ ln)
   in
-  let loc = Loc.make_loc (bp,ep) in
-  (str"Toplevel input, characters " ++ Cerrors.print_loc loc ++ str":" ++ fnl () ++
-     highlight_lines ++ fnl ())
+  let loc  = Loc.make_loc (bp,ep) in
+  (Pp.pr_loc loc ++ highlight_lines ++ fnl ())
 
 (* Functions to report located errors in a file. *)
 
-let print_location_in_file {outer=s;inner=fname} loc =
-  let errstrm = str"Error while reading " ++ str s in
+let print_location_in_file loc =
+  let fname = loc.Loc.fname in
+  let errstrm = str"Error while reading " ++ str fname in
   if Loc.is_ghost loc then
     hov 1 (errstrm ++ spc() ++ str" (unknown location):") ++ fnl ()
   else
-    let errstrm =
-      if String.equal s fname then mt() else errstrm ++ str":" ++ fnl()
+    let errstrm = mt ()
+      (* if String.equal outer_fname fname then mt() else errstrm ++ str":" ++ fnl() *)
     in
-    let (bp,ep) = Loc.unloc loc in
-    let line_of_pos lin bol cnt =
-      try
-        let ic = open_in fname in
-        let rec line_of_pos lin bol cnt =
-          if cnt < bp then
-            if input_char ic == '\n'
-            then line_of_pos (lin + 1) (cnt +1) (cnt+1)
-            else line_of_pos lin bol (cnt+1)
-          else (lin, bol)
-        in
-        let rc = line_of_pos lin bol cnt in
-        close_in ic;
-        rc
-      with Sys_error _ -> 0, 0 in
-    try
-      let (line, bol) = line_of_pos 1 0 0 in
-      hov 0 (* No line break so as to follow emacs error message format *)
-        (errstrm ++ str"File " ++ str "\"" ++ str fname ++ str "\"" ++
-           str", line " ++ int line ++ str", characters " ++
-           Cerrors.print_loc (Loc.make_loc (bp-bol,ep-bol))) ++ str":" ++
-        fnl ()
-    with e when Errors.noncritical e ->
-       hov 1 (errstrm ++ spc() ++ str"(invalid location):") ++ fnl ()
+    let open Loc in
+    hov 0 (* No line break so as to follow emacs error message format *)
+	(errstrm ++ Pp.pr_loc loc)
 
 let valid_buffer_loc ib loc =
   not (Loc.is_ghost loc) &&
@@ -264,14 +243,15 @@ let locate_exn = function
 
 let print_toplevel_error (e, info) =
   let loc = Option.default Loc.ghost (Loc.get_loc info) in
-  let locmsg = match Vernac.get_exn_files info with
-    | Some files -> print_location_in_file files loc
-    | None ->
+  let fname = loc.Loc.fname in
+  let locmsg =
+    if Loc.is_ghost loc || String.equal fname "" then
       if locate_exn e && valid_buffer_loc top_buffer loc then
-        print_highlight_location top_buffer loc
+	print_highlight_location top_buffer loc
       else mt ()
+    else print_location_in_file loc
   in
-  locmsg ++ Errors.iprint (e, info)
+  locmsg ++ CErrors.iprint (e, info)
 
 (* Read the input stream until a dot is encountered *)
 let parse_to_dot =
@@ -292,12 +272,14 @@ let rec discard_to_dot () =
   with
     | Compat.Token.Error _ | CLexer.Error.E _ -> discard_to_dot ()
     | End_of_input -> raise End_of_input
-    | e when Errors.noncritical e -> ()
+    | e when CErrors.noncritical e -> ()
 
-let read_sentence () =
-  try Vernac.parse_sentence (top_buffer.tokens, None)
+let read_sentence input =
+  try
+    let (loc, _ as r) = Vernac.parse_sentence input in
+    CWarnings.set_current_loc loc; r
   with reraise ->
-    let reraise = Errors.push reraise in
+    let reraise = CErrors.push reraise in
     discard_to_dot ();
     iraise reraise
 
@@ -316,19 +298,19 @@ let do_vernac () =
   if !print_emacs then top_stderr (str (top_buffer.prompt()));
   resynch_buffer top_buffer;
   try
-    Vernac.eval_expr (read_sentence ())
+    let input = (top_buffer.tokens, None) in
+    Vernac.process_expr top_buffer.tokens (read_sentence input)
   with
-    | End_of_input | Errors.Quit ->
-        top_stderr (fnl ()); raise Errors.Quit
-    | Errors.Drop ->  (* Last chance *)
-        if Mltop.is_ocaml_top() then raise Errors.Drop
+    | End_of_input | CErrors.Quit ->
+        top_stderr (fnl ()); raise CErrors.Quit
+    | CErrors.Drop ->  (* Last chance *)
+        if Mltop.is_ocaml_top() then raise CErrors.Drop
         else Feedback.msg_error (str"There is no ML toplevel.")
     | any ->
-        let any = Errors.push any in
-        Format.set_formatter_out_channel stdout;
+        let any = CErrors.push any in
         let msg = print_toplevel_error any ++ fnl () in
         pp_with ~pp_tag:Ppstyle.pp_tag !Pp_control.std_ft msg;
-        flush_all ()
+        Format.pp_print_flush !Pp_control.std_ft ()
 
 (** Main coq loop : read vernacular expressions until Drop is entered.
     Ctrl-C is handled internally as Sys.Break instead of aborting Coq.
@@ -345,18 +327,28 @@ let feed_emacs = function
   | _  -> ()
 *)
 
+(* Flush in a compatible order with 8.5 *)
+(* This mimics the semantics of the old Pp.flush_all *)
+let loop_flush_all () =
+  Pervasives.flush stderr;
+  Pervasives.flush stdout;
+  Format.pp_print_flush !Pp_control.std_ft ();
+  Format.pp_print_flush !Pp_control.err_ft ()
+
 let rec loop () =
   Sys.catch_break true;
   if !Flags.print_emacs then Vernacentries.qed_display_script := false;
   Flags.coqtop_ui := true;
   try
     reset_input_buffer stdin top_buffer;
-    while true do do_vernac(); flush_all() done
+    while true do do_vernac(); loop_flush_all () done
   with
-    | Errors.Drop -> ()
-    | Errors.Quit -> exit 0
+    | CErrors.Drop -> ()
+    | CErrors.Quit -> exit 0
     | any ->
       Feedback.msg_error (str"Anomaly: main loop exited with exception: " ++
                 str (Printexc.to_string any) ++
-                fnl() ++ str"Please report.");
+                fnl() ++
+                str"Please report" ++
+                strbrk" at " ++ str Coq_config.wwwbugtracker ++ str ".");
       loop ()
diff --git a/toplevel/coqloop.mli b/toplevel/coqloop.mli
index 00554da30..e40353e0f 100644
--- a/toplevel/coqloop.mli
+++ b/toplevel/coqloop.mli
@@ -18,7 +18,7 @@ type input_buffer = {
   mutable str : string; (** buffer of already read characters *)
   mutable len : int;    (** number of chars in the buffer *)
   mutable bols : int list; (** offsets in str of begining of lines *)
-  mutable tokens : Pcoq.Gram.parsable; (** stream of tokens *)
+  mutable tokens : Pcoq.Gram.coq_parsable; (** stream of tokens *)
   mutable start : int } (** stream count of the first char of the buffer *)
 
 (** The input buffer of stdin. *)
diff --git a/toplevel/coqtop.ml b/toplevel/coqtop.ml
index 869f6bb93..d9f8ed881 100644
--- a/toplevel/coqtop.ml
+++ b/toplevel/coqtop.ml
@@ -7,7 +7,7 @@
 (************************************************************************)
 
 open Pp
-open Errors
+open CErrors
 open Util
 open Flags
 open Names
@@ -26,7 +26,7 @@ let get_version_date () =
     let rev = input_line ch in
     let () = close_in ch in
     (ver,rev)
-  with e when Errors.noncritical e ->
+  with e when CErrors.noncritical e ->
     (Coq_config.version,Coq_config.date)
 
 let print_header () =
@@ -54,15 +54,14 @@ let init_color () =
     Terminal.has_style Unix.stderr &&
     (* emacs compilation buffer does not support colors by default,
        its TERM variable is set to "dumb". *)
-    Unix.getenv "TERM" <> "dumb"
+    try Sys.getenv "TERM" <> "dumb" with Not_found -> false
   in
   if has_color then begin
     let colors = try Some (Sys.getenv "COQ_COLORS") with Not_found -> None in
     match colors with
     | None ->
       (** Default colors *)
-      Ppstyle.init_color_output ();
-      Feedback.set_logger Feedback.color_terminal_logger
+      Feedback.init_color_output ()
     | Some "" ->
       (** No color output *)
       ()
@@ -70,8 +69,7 @@ let init_color () =
       (** Overwrite all colors *)
       Ppstyle.clear_styles ();
       Ppstyle.parse_config s;
-      Ppstyle.init_color_output ();
-      Feedback.set_logger Feedback.color_terminal_logger
+      Feedback.init_color_output ()
   end
 
 let toploop_init = ref begin fun x ->
@@ -115,23 +113,14 @@ let _ = at_exit print_memory_stat
 
 let impredicative_set = ref Declarations.PredicativeSet
 let set_impredicative_set c = impredicative_set := Declarations.ImpredicativeSet
-let type_in_type = ref Declarations.StratifiedType
-let set_type_in_type () = type_in_type := Declarations.TypeInType
+let set_type_in_type () =
+  let typing_flags = Environ.typing_flags (Global.env ()) in
+  Global.set_typing_flags { typing_flags with Declarations.check_universes = false }
 let engage () =
-  Global.set_engagement (!impredicative_set,!type_in_type)
+  Global.set_engagement !impredicative_set
 
 let set_batch_mode () = batch_mode := true
 
-let user_warning = ref false
-(** User explicitly set warning *)
-
-let set_warning p =
-  let () = user_warning := true in
-  match p with
-  | "all" -> make_warn true
-  | "none" -> make_warn false
-  | _ -> prerr_endline ("Error: all/none expected after option w"); exit 1
-
 let toplevel_default_name = DirPath.make [Id.of_string "Top"]
 let toplevel_name = ref (Some toplevel_default_name)
 let set_toplevel_name dir =
@@ -141,18 +130,27 @@ let unset_toplevel_name () = toplevel_name := None
 
 let remove_top_ml () = Mltop.remove ()
 
+let warn_deprecated_inputstate =
+  CWarnings.create ~name:"deprecated-inputstate" ~category:"deprecated"
+         (fun () -> strbrk "The inputstate option is deprecated and discouraged.")
+
 let inputstate = ref ""
 let set_inputstate s =
-  let () = Feedback.msg_warning (str "The inputstate option is deprecated and discouraged.") in
+  warn_deprecated_inputstate ();
   inputstate:=s
 let inputstate () =
   if not (String.is_empty !inputstate) then
     let fname = Loadpath.locate_file (CUnix.make_suffix !inputstate ".coq") in
     intern_state fname
 
+let warn_deprecated_outputstate =
+  CWarnings.create ~name:"deprecated-outputstate" ~category:"deprecated"
+         (fun () ->
+          strbrk "The outputstate option is deprecated and discouraged.")
+
 let outputstate = ref ""
 let set_outputstate s =
-  let () = Feedback.msg_warning (str "The outputstate option is deprecated and discouraged.") in
+  warn_deprecated_outputstate ();
   outputstate:=s
 let outputstate () =
   if not (String.is_empty !outputstate) then
@@ -170,7 +168,7 @@ let load_vernacular () =
   List.iter
     (fun (s,b) ->
       let s = Loadpath.locate_file s in
-      if Flags.do_beautify () then
+      if !Flags.beautify then
 	with_option beautify_file (Vernac.load_vernac b) s
       else
 	Vernac.load_vernac b s)
@@ -200,6 +198,7 @@ let require () =
 let add_compat_require v =
   match v with
   | Flags.V8_4 -> add_require "Coq.Compat.Coq84"
+  | Flags.V8_5 -> add_require "Coq.Compat.Coq85"
   | _ -> ()
 
 let compile_list = ref ([] : (bool * string) list)
@@ -220,24 +219,20 @@ let add_compile verbose s =
   compile_list := (verbose,s) :: !compile_list
 
 let compile_file (v,f) =
-  if Flags.do_beautify () then
+  if !Flags.beautify then
     with_option beautify_file (Vernac.compile v) f
   else
     Vernac.compile v f
 
 let compile_files () =
-  match !compile_list with
-    | [] -> ()
-    | [vf] -> compile_file vf (* One compilation : no need to save init state *)
-    | l ->
-      let init_state = States.freeze ~marshallable:`No in
-      let coqdoc_init_state = CLexer.location_table () in
-      List.iter
-        (fun vf ->
-	  States.unfreeze init_state;
-	  CLexer.restore_location_table coqdoc_init_state;
-          compile_file vf)
-        (List.rev l)
+  if !compile_list == [] then ()
+  else
+    let init_state = States.freeze ~marshallable:`No in
+    Feedback.(add_feeder debug_feeder);
+    List.iter (fun vf ->
+        States.unfreeze init_state;
+        compile_file vf)
+      (List.rev !compile_list)
 
 (** Options for proof general *)
 
@@ -292,7 +287,7 @@ let init_gc () =
     between coqtop and coqc. *)
 
 let usage () =
-  Envars.set_coqlib Errors.error;
+  Envars.set_coqlib CErrors.error;
   init_load_path ();
   if !batch_mode then Usage.print_usage_coqc ()
   else begin
@@ -333,9 +328,6 @@ let error_missing_arg s =
 let filter_opts = ref false
 let exitcode () = if !filter_opts then 2 else 0
 
-let verb_compat_ntn = ref false
-let no_compat_ntn = ref false
-
 let print_where = ref false
 let print_config = ref false
 let print_tags = ref false
@@ -370,15 +362,25 @@ let get_int opt n =
   with Failure _ ->
     prerr_endline ("Error: integer expected after option "^opt); exit 1
 
+let get_float opt n =
+  try float_of_string n
+  with Failure _ ->
+    prerr_endline ("Error: float expected after option "^opt); exit 1
+
 let get_host_port opt s =
   match CString.split ':' s with
   | [host; portr; portw] ->
        Some (Spawned.Socket(host, int_of_string portr, int_of_string portw))
   | ["stdfds"] -> Some Spawned.AnonPipe
   | _ ->
-     prerr_endline ("Error: host:port or stdfds expected after option "^opt);
+     prerr_endline ("Error: host:portr:portw or stdfds expected after option "^opt);
      exit 1
 
+let get_error_resilience opt = function
+  | "on" | "all" | "yes" -> `All
+  | "off" | "no" -> `None
+  | s -> `Only (String.split ',' s)
+
 let get_task_list s = List.map int_of_string (Str.split (Str.regexp ",") s)
 
 let vio_tasks = ref []
@@ -492,6 +494,12 @@ let parse_args arglist =
         Flags.async_proofs_worker_priority := get_priority opt (next ())
     |"-async-proofs-private-flags" ->
         Flags.async_proofs_private_flags := Some (next ());
+    |"-async-proofs-tactic-error-resilience" ->
+        Flags.async_proofs_tac_error_resilience := get_error_resilience opt (next ())
+    |"-async-proofs-command-error-resilience" ->
+        Flags.async_proofs_cmd_error_resilience := get_bool opt (next ())
+    |"-async-proofs-delegation-threshold" ->
+        Flags.async_proofs_delegation_threshold:= get_float opt (next ())
     |"-worker-id" -> set_worker_id opt (next ())
     |"-compat" -> let v = get_compat_version (next ()) in Flags.compat_version := v; add_compat_require v
     |"-compile" -> add_compile false (next ())
@@ -508,6 +516,7 @@ let parse_args arglist =
     |"-load-vernac-source-verbose"|"-lv" -> add_load_vernacular true (next ())
     |"-outputstate" -> set_outputstate (next ())
     |"-print-mod-uid" -> let s = String.concat " " (List.map get_native_name rem) in print_endline s; exit 0
+    |"-profile-ltac-cutoff" -> Flags.profile_ltac := true; Flags.profile_ltac_cutoff := get_float opt (next ())
     |"-require" -> add_require (next ())
     |"-top" -> set_toplevel_name (dirpath_of_string (next ()))
     |"-with-geoproof" -> Coq_config.with_geoproof := get_bool opt (next ())
@@ -515,7 +524,8 @@ let parse_args arglist =
     |"-control-channel" -> Spawned.control_channel := get_host_port opt (next())
     |"-vio2vo" -> add_compile false (next ()); Flags.compilation_mode := Vio2Vo
     |"-toploop" -> set_toploop (next ())
-    |"-w" -> set_warning (next ())
+    |"-w" | "-W" -> CWarnings.set_flags (CWarnings.normalize_flags_string (next ()))
+    |"-o" -> Flags.compilation_output_name := Some (next())
 
     (* Options with zero arg *)
     |"-async-queries-always-delegate"
@@ -526,7 +536,7 @@ let parse_args arglist =
         Flags.async_proofs_never_reopen_branch := true;
     |"-batch" -> set_batch_mode ()
     |"-test-mode" -> test_mode := true
-    |"-beautify" -> make_beautify true
+    |"-beautify" -> beautify := true
     |"-boot" -> boot := true; no_load_rc ()
     |"-bt" -> Backtrace.record_backtrace true
     |"-color" -> set_color (next ())
@@ -538,10 +548,9 @@ let parse_args arglist =
     |"-ideslave" -> set_ideslave ()
     |"-impredicative-set" -> set_impredicative_set ()
     |"-indices-matter" -> Indtypes.enforce_indices_matter ()
-    |"-just-parsing" -> Vernac.just_parsing := true
+    |"-just-parsing" -> warning "-just-parsing option has been removed in 8.6"
     |"-m"|"--memory" -> memory_stat := true
     |"-noinit"|"-nois" -> load_init := false
-    |"-no-compat-notations" -> no_compat_ntn := true
     |"-no-glob"|"-noglob" -> Dumpglob.noglob (); glob_opt := true
     |"-native-compiler" ->
       if Coq_config.no_native_compiler then
@@ -549,6 +558,7 @@ let parse_args arglist =
       else native_compiler := true
     |"-notop" -> unset_toplevel_name ()
     |"-output-context" -> output_context := true
+    |"-profile-ltac" -> Flags.profile_ltac := true
     |"-q" -> no_load_rc ()
     |"-quiet"|"-silent" -> Flags.make_silent true; Flags.make_warn false
     |"-quick" -> Flags.compilation_mode := BuildVio
@@ -557,7 +567,7 @@ let parse_args arglist =
     |"-type-in-type" -> set_type_in_type ()
     |"-unicode" -> add_require "Utf8_core"
     |"-v"|"--version" -> Usage.version (exitcode ())
-    |"-verbose-compat-notations" -> verb_compat_ntn := true
+    |"--print-version" -> Usage.machine_readable_version (exitcode ())
     |"-where" -> print_where := true
     |"-xml" -> Flags.xml_export := true
 
@@ -586,8 +596,8 @@ let parse_args arglist =
   with
     | UserError(_, s) as e ->
       if is_empty s then exit 1
-      else fatal_error (Errors.print e) false
-    | any -> fatal_error (Errors.print any) (Errors.is_anomaly any)
+      else fatal_error (CErrors.print e) false
+    | any -> fatal_error (CErrors.print any) (CErrors.is_anomaly any)
 
 let init_toplevel arglist =
   init_gc ();
@@ -601,7 +611,7 @@ let init_toplevel arglist =
       (* If we have been spawned by the Spawn module, this has to be done
        * early since the master waits us to connect back *)
       Spawned.init_channels ();
-      Envars.set_coqlib Errors.error;
+      Envars.set_coqlib CErrors.error;
       if !print_where then (print_endline(Envars.coqlib ()); exit(exitcode ()));
       if !print_config then (Usage.print_config (); exit (exitcode ()));
       if !print_tags then (print_style_tags (); exit (exitcode ()));
@@ -618,9 +628,6 @@ let init_toplevel arglist =
       inputstate ();
       Mltop.init_known_plugins ();
       engage ();
-      (* Be careful to set these variables after the inputstate *)
-      Syntax_def.set_verbose_compat_notations !verb_compat_ntn;
-      Syntax_def.set_compat_notations (not !no_compat_ntn);
       if (not !batch_mode || List.is_empty !compile_list)
          && Global.env_is_initial ()
       then Option.iter Declaremods.start_library !toplevel_name;
@@ -636,13 +643,13 @@ let init_toplevel arglist =
       check_vio_tasks ();
       outputstate ()
     with any ->
-      let any = Errors.push any in
+      let any = CErrors.push any in
       flush_all();
       let msg =
         if !batch_mode then mt ()
         else str "Error during initialization:" ++ fnl ()
       in
-      let is_anomaly e = Errors.is_anomaly e || not (Errors.handled e) in
+      let is_anomaly e = CErrors.is_anomaly e || not (CErrors.handled e) in
       fatal_error (msg ++ Coqloop.print_toplevel_error any) (is_anomaly (fst any))
   end;
   if !batch_mode then begin
@@ -657,7 +664,6 @@ let start () =
   let () = init_toplevel (List.tl (Array.to_list Sys.argv)) in
   (* In batch mode, Coqtop has already exited at this point. In interactive one,
      dump glob is nothing but garbage ...  *)
-  if not !user_warning then make_warn true;
   !toploop_run ();
   exit 1
 
diff --git a/toplevel/toplevel.mllib b/toplevel/toplevel.mllib
index 5aa7d428a..10bf48647 100644
--- a/toplevel/toplevel.mllib
+++ b/toplevel/toplevel.mllib
@@ -1,19 +1,3 @@
-Himsg
-Cerrors
-Class
-Locality
-Metasyntax
-Auto_ind_decl
-Search
-Indschemes
-Obligations
-Command
-Classes
-Record
-Assumptions
-Vernacinterp
-Mltop
-Vernacentries
 Vernac
 Usage
 Coqloop
diff --git a/toplevel/usage.ml b/toplevel/usage.ml
index f855c096e..38ceacf5e 100644
--- a/toplevel/usage.ml
+++ b/toplevel/usage.ml
@@ -11,6 +11,10 @@ let version ret =
     Coq_config.version Coq_config.date;
   Printf.printf "compiled on %s with OCaml %s\n" Coq_config.compile_date Coq_config.caml_version;
   exit ret
+let machine_readable_version ret =
+  Printf.printf "%s %s\n"
+    Coq_config.version Coq_config.caml_version;
+  exit ret
 
 (* print the usage of coqtop (or coqc) on channel co *)
 
@@ -32,8 +36,6 @@ let print_usage_channel co command =
 \n  -noinit                start without loading the Init library\
 \n  -nois                  (idem)\
 \n  -compat X.Y            provides compatibility support for Coq version X.Y\
-\n  -verbose-compat-notations  be warned when using compatibility notations\
-\n  -no-compat-notations   get an error when using compatibility notations\
 \n\
 \n  -load-ml-object f      load ML object file f\
 \n  -load-ml-source f      load ML file f\
@@ -45,6 +47,7 @@ let print_usage_channel co command =
 \n  -require path          load Coq library path and import it (Require Import path.)\
 \n  -compile f.v           compile Coq file f.v (implies -batch)\
 \n  -compile-verbose f.v   verbosely compile Coq file f.v (implies -batch)\
+\n  -o f.vo                use f.vo as the output file name\
 \n  -quick                 quickly compile .v files to .vio files (skip proofs)\
 \n  -schedule-vio2vo j f1..fn   run up to j instances of Coq to turn each fi.vio\
 \n                         into fi.vo\
@@ -56,8 +59,8 @@ let print_usage_channel co command =
 \n  -v                     print Coq version and exit\
 \n  -list-tags             print highlight color tags known by Coq and exit\
 \n\
-\n  -quiet                 unset display of extra information (implies -w none)\
-\n  -w (all|none)          configure display of warnings\
+\n  -quiet                 unset display of extra information (implies -w \"-all\")\
+\n  -w (w1,..,wn)          configure display of warnings\
 \n  -color (yes|no|auto)   configure color output\
 \n\
 \n  -q                     skip loading of rcfile\
@@ -77,6 +80,7 @@ let print_usage_channel co command =
 \n                         the directory $COQ_XML_LIBRARY_ROOT (if set) or to\
 \n                         stdout (if unset)\
 \n  -time                  display the time taken by each command\
+\n  -profile-ltac          display the time taken by each (sub)tactic\
 \n  -m, --memory           display total heap size at program exit\
 \n                         (use environment variable\
 \n                          OCAML_GC_STATS=\"/tmp/gclog.txt\"\
diff --git a/toplevel/usage.mli b/toplevel/usage.mli
index 3ce9e93ee..dccb40e71 100644
--- a/toplevel/usage.mli
+++ b/toplevel/usage.mli
@@ -9,6 +9,7 @@
 (** {6 Prints the version number on the standard output and exits (with 0). } *)
 
 val version : int -> 'a
+val machine_readable_version : int -> 'a
 
 (** {6 Prints the usage on the error output, preceeded by a user-provided message. } *)
 val print_usage : string -> unit
diff --git a/toplevel/vernac.ml b/toplevel/vernac.ml
index 1c3f0d997..f914f83b9 100644
--- a/toplevel/vernac.ml
+++ b/toplevel/vernac.ml
@@ -9,7 +9,7 @@
 (* Parsing of vernacular. *)
 
 open Pp
-open Errors
+open CErrors
 open Util
 open Flags
 open Vernacexpr
@@ -18,14 +18,17 @@ open Vernacexpr
    Use the module Coqtoplevel, which catches these exceptions
    (the exceptions are explained only at the toplevel). *)
 
-(* The navigation vernac commands will be handled separately *)
+let user_error loc s = CErrors.user_err ~loc (str s)
+
+(* Navigation commands are allowed in a coqtop session but not in a .v file *)
 
 let rec is_navigation_vernac = function
   | VernacResetInitial
   | VernacResetName _
   | VernacBacktrack _
   | VernacBackTo _
-  | VernacBack _ -> true
+  | VernacBack _
+  | VernacStm _ -> true
   | VernacRedirect (_, (_,c))
   | VernacTime (_,c) ->
       is_navigation_vernac c (* Time Back* is harmless *)
@@ -41,6 +44,14 @@ let is_reset = function
   | VernacResetInitial | VernacResetName _ -> true
   | _ -> false
 
+let checknav_simple loc cmd =
+  if is_navigation_vernac cmd && not (is_reset cmd) then
+    user_error loc "Navigation commands forbidden in files."
+
+let checknav_deep loc ast =
+  if is_deep_navigation_vernac ast then
+    user_error loc "Navigation commands forbidden in nested commands."
+
 (* When doing Load on a file, two behaviors are possible:
 
    - either the history stack is grown by only one command,
@@ -65,32 +76,10 @@ let _ =
       Goptions.optread  = (fun () -> !atomic_load);
       Goptions.optwrite = ((:=) atomic_load) }
 
-(* In case of error, register the file being currently Load'ed and the
-   inner file in which the error has been encountered. Any intermediate files
-   between the two are discarded. *)
-
-type location_files = { outer : string; inner : string }
-
-let files_of_exn : location_files Exninfo.t = Exninfo.make ()
-
-let get_exn_files e = Exninfo.get e files_of_exn
-
-let add_exn_files e f = Exninfo.add e files_of_exn f
-
-let enrich_with_file f (e, info) =
-  let inner = match get_exn_files info with None -> f | Some x -> x.inner in
-  (e, add_exn_files info { outer = f; inner })
-
-let raise_with_file f e = iraise (enrich_with_file f e)
-
-let cur_file = ref None
-
 let disable_drop = function
-  | Drop -> Errors.error "Drop is forbidden."
+  | Drop -> CErrors.error "Drop is forbidden."
   | e -> e
 
-let user_error loc s = Errors.user_err_loc (loc,"_",str s)
-
 (* Opening and closing a channel. Open it twice when verbose: the first
    channel is used to read the commands, and the second one to print them.
    Note: we could use only one thanks to seek_in, but seeking on and on in
@@ -100,7 +89,7 @@ let open_file_twice_if verbosely longfname =
   let in_chan = open_utf8_file_in longfname in
   let verb_ch =
     if verbosely then Some (open_utf8_file_in longfname) else None in
-  let po = Pcoq.Gram.parsable (Stream.of_channel in_chan) in
+  let po = Pcoq.Gram.parsable ~file:longfname (Stream.of_channel in_chan) in
   (in_chan, longfname, (po, verb_ch))
 
 let close_input in_chan (_,verb) =
@@ -109,17 +98,17 @@ let close_input in_chan (_,verb) =
     match verb with
       | Some verb_ch -> close_in verb_ch
       | _ -> ()
-  with e when Errors.noncritical e -> ()
+  with e when CErrors.noncritical e -> ()
 
 let verbose_phrase verbch loc =
   let loc = Loc.unloc loc in
   match verbch with
     | Some ch ->
 	let len = snd loc - fst loc in
-	let s = String.create len in
+	let s = Bytes.create len in
         seek_in ch (fst loc);
         really_input ch s 0 len;
-        Feedback.msg_notice (str s ++ fnl ())
+        Feedback.msg_notice (str s)
     | None -> ()
 
 exception End_of_input
@@ -133,53 +122,47 @@ let parse_sentence = Flags.with_option Flags.we_are_parsing
 (* vernac parses the given stream, executes interpfun on the syntax tree it
  * parses, and is verbose on "primitives" commands if verbosely is true *)
 
-let just_parsing = ref false
 let chan_beautify = ref stdout
 let beautify_suffix = ".beautified"
 
-let set_formatter_translator() =
-  let ch = !chan_beautify in
+let set_formatter_translator ch =
   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 pr_new_syntax loc ocom =
+let pr_new_syntax_in_context loc chan_beautify ocom =
   let loc = Loc.unloc loc in
-  if !beautify_file then set_formatter_translator();
+  if !beautify_file then set_formatter_translator chan_beautify;
   let fs = States.freeze ~marshallable:`No in
-  let com = match ocom with
-    | Some com -> Ppvernac.pr_vernac com
-    | None -> mt() in
-  if !beautify_file then
-    Feedback.msg_notice (hov 0 (comment (fst loc) ++ com ++ comment (snd loc)))
-  else
-    Feedback.msg_info (hov 4 (str"New Syntax:" ++ fnl() ++ (hov 0 com)));
-  States.unfreeze fs;
-  Format.set_formatter_out_channel stdout
-
-let save_translator_coqdoc () =
-  (* translator state *)
-  let ch = !chan_beautify in
-  let cl = !Pp.comments in
-  let cs = CLexer.com_state() in
-  (* end translator state *)
-  let coqdocstate = CLexer.location_table () in
-  ch,cl,cs,coqdocstate
-
-let restore_translator_coqdoc (ch,cl,cs,coqdocstate) =
-  if !Flags.beautify_file then close_out !chan_beautify;
-  chan_beautify := ch;
-  Pp.comments := cl;
-  CLexer.restore_com_state cs;
-  CLexer.restore_location_table coqdocstate
+  (* The content of this is not supposed to fail, but if ever *)
+  try
+    (* Side-effect: order matters *)
+    let before = comment (CLexer.extract_comments (fst loc)) in
+    let com = match ocom with
+      | Some com -> Ppvernac.pr_vernac com
+      | None -> mt() in
+    let after = comment (CLexer.extract_comments (snd loc)) in
+    if !beautify_file then
+      Pp.msg_with !Pp_control.std_ft (hov 0 (before ++ com ++ after))
+    else
+      Feedback.msg_info (hov 4 (str"New Syntax:" ++ fnl() ++ (hov 0 com)));
+    States.unfreeze fs;
+    Format.set_formatter_out_channel stdout
+  with any ->
+    States.unfreeze fs;
+    Format.set_formatter_out_channel stdout
+
+let pr_new_syntax po loc chan_beautify ocom =
+  (* Reinstall the context of parsing which includes the bindings of comments to locations *)
+  Pcoq.Gram.with_parsable po (pr_new_syntax_in_context chan_beautify loc) ocom
 
 (* For coqtop -time, we display the position in the file,
    and a glimpse of the executed command *)
 
-let display_cmd_header loc com =
+let pp_cmd_header loc com =
   let shorten s = try (String.sub s 0 30)^"..." with _ -> s in
   let noblank s =
-    for i = 0 to String.length s - 1 do
+    for i = 0 to Bytes.length s - 1 do
       match s.[i] with
 	| ' ' | '\n' | '\t' | '\r' -> s.[i] <- '~'
 	| _ -> ()
@@ -191,75 +174,63 @@ let display_cmd_header loc com =
     try Ppvernac.pr_vernac x
     with e -> str (Printexc.to_string e) in
   let cmd = noblank (shorten (string_of_ppcmds (safe_pr_vernac com)))
-  in
-  Feedback.msg_notice
-    (str "Chars " ++ int start ++ str " - " ++ int stop ++
-     str " [" ++ str cmd ++ str "] ")
+  in str "Chars " ++ int start ++ str " - " ++ int stop ++
+     str " [" ++ str cmd ++ str "] "
 
+(* This is a special case where we assume we are in console batch mode
+   and take control of the console.
+ *)
+let print_cmd_header loc com =
+  Pp.pp_with ~pp_tag:Ppstyle.pp_tag !Pp_control.std_ft (pp_cmd_header loc com);
+  Format.pp_print_flush !Pp_control.std_ft ()
 
-let rec vernac_com verbose checknav (loc,com) =
+let rec interp_vernac po chan_beautify checknav (loc,com) =
   let interp = function
     | VernacLoad (verbosely, fname) ->
 	let fname = Envars.expand_path_macros ~warn:(fun x -> Feedback.msg_warning (str x)) fname in
         let fname = CUnix.make_suffix fname ".v" in
         let f = Loadpath.locate_file fname in
-	let st = save_translator_coqdoc () in
-	if !Flags.beautify_file then
-	  begin
-	    chan_beautify := open_out (f^beautify_suffix);
-	    Pp.comments := []
-          end;
-	begin
-	  try
-            read_vernac_file verbosely f;
-	    restore_translator_coqdoc st;
-	  with reraise ->
-            let reraise = Errors.push reraise in
-	    restore_translator_coqdoc st;
-	    iraise reraise
-	end
-
-    | v when !just_parsing -> ()
-
-    | v -> Stm.interp verbose (loc,v)
+        load_vernac verbosely f
+
+    | v -> Stm.interp (Flags.is_verbose()) (loc,v)
   in
     try
       checknav loc com;
-      if do_beautify () then pr_new_syntax loc (Some com);
-      if !Flags.time then display_cmd_header loc com;
+      if !beautify then pr_new_syntax po chan_beautify loc (Some com);
+      (* XXX: This is not 100% correct if called from an IDE context *)
+      if !Flags.time then print_cmd_header loc com;
       let com = if !Flags.time then VernacTime (loc,com) else com in
       interp com
     with reraise ->
-      let (reraise, info) = Errors.push reraise in
-      Format.set_formatter_out_channel stdout;
+      let (reraise, info) = CErrors.push reraise in
       let loc' = Option.default Loc.ghost (Loc.get_loc info) in
       if Loc.is_ghost loc' then iraise (reraise, Loc.add_loc info loc)
       else iraise (reraise, info)
 
-and read_vernac_file verbosely s =
-  let checknav loc cmd =
-    if is_navigation_vernac cmd && not (is_reset cmd) then
-	user_error loc "Navigation commands forbidden in files"
-  in
-  let (in_chan, fname, input) = open_file_twice_if verbosely s in
-  cur_file := Some fname;
+(* Load a vernac file. CErrors are annotated with file and location *)
+and load_vernac verbosely file =
+  let chan_beautify =
+    if !Flags.beautify_file then open_out (file^beautify_suffix) else stdout in
+  let (in_chan, fname, input) = open_file_twice_if verbosely file in
   try
     (* we go out of the following infinite loop when a End_of_input is
      * raised, which means that we raised the end of the file being loaded *)
     while true do
-      let loc_ast = parse_sentence input in
-      vernac_com verbosely checknav loc_ast
+      let loc_ast = Flags.silently parse_sentence input in
+      CWarnings.set_current_loc (fst loc_ast);
+      Flags.silently (interp_vernac (fst input) chan_beautify checknav_simple) loc_ast;
     done
   with any ->   (* whatever the exception *)
-    let (e, info) = Errors.push any in
-    Format.set_formatter_out_channel stdout;
+    let (e, info) = CErrors.push any in
     close_input in_chan input;    (* we must close the file first *)
     match e with
       | End_of_input ->
-          cur_file := None;
-          if do_beautify () then
-            pr_new_syntax (Loc.make_loc (max_int,max_int)) None
-      | _ -> raise_with_file fname (disable_drop e, info)
+          if !beautify then
+            pr_new_syntax (fst input) chan_beautify (Loc.make_loc (max_int,max_int)) None;
+          if !Flags.beautify_file then close_out chan_beautify;
+      | reraise ->
+         if !Flags.beautify_file then close_out chan_beautify;
+	 iraise (disable_drop e, info)
 
 (** [eval_expr : ?preserving:bool -> Loc.t * Vernacexpr.vernac_expr -> unit]
    It executes one vernacular command. By default the command is
@@ -268,34 +239,50 @@ and read_vernac_file verbosely s =
    of a new state label). An example of state-preserving command is one coming
    from the query panel of Coqide. *)
 
-let checknav loc ast =
-  if is_deep_navigation_vernac ast then
-    user_error loc "Navigation commands forbidden in nested commands"
-
-let eval_expr loc_ast = vernac_com (Flags.is_verbose()) checknav loc_ast
+let process_expr po loc_ast = interp_vernac po stdout checknav_deep loc_ast
 
 (* XML output hooks *)
 let (f_xml_start_library, xml_start_library) = Hook.make ~default:ignore ()
 let (f_xml_end_library, xml_end_library) = Hook.make ~default:ignore ()
 
-(* Load a vernac file. Errors are annotated with file and location *)
-let load_vernac verb file =
-  chan_beautify :=
-    if !Flags.beautify_file then open_out (file^beautify_suffix) else stdout;
-  try
-    Flags.silently (read_vernac_file verb) file;
-    if !Flags.beautify_file then close_out !chan_beautify;
-  with any ->
-    let (e, info) = Errors.push any in
-    if !Flags.beautify_file then close_out !chan_beautify;
-    raise_with_file file (disable_drop e, info)
+let warn_file_no_extension =
+  CWarnings.create ~name:"file-no-extension" ~category:"filesystem"
+         (fun (f,ext) ->
+          str "File \"" ++ str f ++
+            strbrk "\" has been implicitly expanded to \"" ++
+            str f ++ str ext ++ str "\"")
 
-let ensure_v f =
-  if Filename.check_suffix f ".v" then f
+let ensure_ext ext f =
+  if Filename.check_suffix f ext then f
   else begin
-    Feedback.msg_warning (str "File \"" ++ str f ++ strbrk "\" has been implicitly \
-    expanded to \"" ++ str f ++ str ".v\"");
-    f ^ ".v"
+    warn_file_no_extension (f,ext);
+    f ^ ext
+  end
+
+let chop_extension f =
+  try Filename.chop_extension f with _ -> f
+
+let ensure_bname src tgt =
+  let src, tgt = Filename.basename src, Filename.basename tgt in
+  let src, tgt = chop_extension src, chop_extension tgt in
+  if src <> tgt then begin
+    Feedback.msg_error (str "Source and target file names must coincide, directories can differ");
+    Feedback.msg_error (str "Source: " ++ str src);
+    Feedback.msg_error (str "Target: " ++ str tgt);
+    flush_all ();
+    exit 1
+  end
+
+let ensure ext src tgt = ensure_bname src tgt; ensure_ext ext tgt
+
+let ensure_v v = ensure ".v" v v
+let ensure_vo v vo = ensure ".vo" v vo
+let ensure_vio v vio = ensure ".vio" v vio
+
+let ensure_exists f =
+  if not (Sys.file_exists f) then begin
+    Feedback.msg_error (hov 0 (str "Can't find file" ++ spc () ++ str f));
+    exit 1
   end
 
 (* Compile a vernac file *)
@@ -307,10 +294,17 @@ let compile verbosely f =
   match !Flags.compilation_mode with
   | BuildVo ->
       let long_f_dot_v = ensure_v f in
-      let ldir = Flags.verbosely Library.start_library long_f_dot_v in
-      Stm.set_compilation_hints long_f_dot_v;
-      Aux_file.start_aux_file_for long_f_dot_v;
-      Dumpglob.start_dump_glob long_f_dot_v;
+      ensure_exists long_f_dot_v;
+      let long_f_dot_vo =
+        match !Flags.compilation_output_name with
+        | None -> long_f_dot_v ^ "o"
+        | Some f -> ensure_vo long_f_dot_v f in
+      let ldir = Flags.verbosely Library.start_library long_f_dot_vo in
+      Stm.set_compilation_hints long_f_dot_vo;
+      Aux_file.(start_aux_file
+        ~aux_file:(aux_file_name_for long_f_dot_vo)
+        ~v_file:long_f_dot_v);
+      Dumpglob.start_dump_glob ~vfile:long_f_dot_v ~vofile:long_f_dot_vo;
       Dumpglob.dump_string ("F" ^ Names.DirPath.to_string ldir ^ "\n");
       if !Flags.xml_export then Hook.get f_xml_start_library ();
       let wall_clock1 = Unix.gettimeofday () in
@@ -318,7 +312,7 @@ let compile verbosely f =
       Stm.join ();
       let wall_clock2 = Unix.gettimeofday () in
       check_pending_proofs ();
-      Library.save_library_to ldir long_f_dot_v (Global.opaque_tables ());
+      Library.save_library_to ldir long_f_dot_vo (Global.opaque_tables ());
       Aux_file.record_in_aux_at Loc.ghost "vo_compile_time"
         (Printf.sprintf "%.3f" (wall_clock2 -. wall_clock1));
       Aux_file.stop_aux_file ();
@@ -326,13 +320,18 @@ let compile verbosely f =
       Dumpglob.end_dump_glob ()
   | BuildVio ->
       let long_f_dot_v = ensure_v f in
-      let ldir = Flags.verbosely Library.start_library long_f_dot_v in
+      ensure_exists long_f_dot_v;
+      let long_f_dot_vio =
+        match !Flags.compilation_output_name with
+        | None -> long_f_dot_v ^ "io"
+        | Some f -> ensure_vio long_f_dot_v f in
+      let ldir = Flags.verbosely Library.start_library long_f_dot_vio in
       Dumpglob.noglob ();
-      Stm.set_compilation_hints long_f_dot_v;
+      Stm.set_compilation_hints long_f_dot_vio;
       let _ = load_vernac verbosely long_f_dot_v in
       Stm.finish ();
       check_pending_proofs ();
-      Stm.snapshot_vio ldir long_f_dot_v;
+      Stm.snapshot_vio ldir long_f_dot_vio;
       Stm.reset_task_queue ()
   | Vio2Vo ->
       let open Filename in
@@ -344,13 +343,10 @@ let compile verbosely f =
       let univs, proofs = Stm.finish_tasks lfdv univs disch proofs tasks in
       Library.save_library_raw lfdv sum lib univs proofs
 
-let compile v f = 
+let compile v f =
   ignore(CoqworkmgrApi.get 1);
   compile v f;
   CoqworkmgrApi.giveback 1
 
-let () = Hook.set Stm.process_error_hook (fun e ->
-  match !cur_file with
-  | None -> Cerrors.process_vernac_interp_error e
-  | Some f -> enrich_with_file f (Cerrors.process_vernac_interp_error e)
-)
+let () = Hook.set Stm.process_error_hook
+  ExplainErr.process_vernac_interp_error
diff --git a/toplevel/vernac.mli b/toplevel/vernac.mli
index 008d7a31a..0d9f5871a 100644
--- a/toplevel/vernac.mli
+++ b/toplevel/vernac.mli
@@ -11,17 +11,14 @@
 (** Read a vernac command on the specified input (parse only).
    Raises [End_of_file] if EOF (or Ctrl-D) is reached. *)
 
-val parse_sentence : Pcoq.Gram.parsable * in_channel option ->
+val parse_sentence : Pcoq.Gram.coq_parsable * in_channel option ->
  Loc.t * Vernacexpr.vernac_expr
 
-(** Reads and executes vernac commands from a stream.
-   The boolean [just_parsing] disables interpretation of commands. *)
+(** Reads and executes vernac commands from a stream. *)
 
 exception End_of_input
 
-val just_parsing : bool ref
-
-val eval_expr : Loc.t * Vernacexpr.vernac_expr -> unit
+val process_expr : Pcoq.Gram.coq_parsable -> Loc.t * Vernacexpr.vernac_expr -> unit
 
 (** Set XML hooks *)
 val xml_start_library : (unit -> unit) Hook.t
@@ -38,9 +35,3 @@ val load_vernac : bool -> string -> unit
 val compile : bool -> string -> unit
 
 val is_navigation_vernac : Vernacexpr.vernac_expr -> bool
-
-(** Has an exception been annotated with some file locations ? *)
-
-type location_files = { outer : string; inner : string }
-
-val get_exn_files : Exninfo.info -> location_files option
diff --git a/toplevel/assumptions.ml b/vernac/assumptions.ml
index 1802b2d36..8865cd646 100644
--- a/toplevel/assumptions.ml
+++ b/vernac/assumptions.ml
@@ -15,7 +15,7 @@
    Module-traversing code: Pierre Letouzey *)
 
 open Pp
-open Errors
+open CErrors
 open Util
 open Names
 open Term
@@ -25,6 +25,8 @@ open Globnames
 open Printer
 open Context.Named.Declaration
 
+module NamedDecl = Context.Named.Declaration
+
 (** For a constant c in a module sealed by an interface (M:T and
     not M<:T), [Global.lookup_constant] may return a [constant_body]
     without body. We fix this by looking in the implementation
@@ -144,7 +146,7 @@ let label_of = function
 
 let rec traverse current ctx accu t = match kind_of_term t with
 | Var id ->
-  let body () = Global.lookup_named id |> get_value in
+  let body () = id |> Global.lookup_named |> NamedDecl.get_value in
   traverse_object accu body (VarRef id)
 | Const (kn, _) ->
   let body () = Global.body_of_constant_body (lookup_constant kn) in
@@ -283,14 +285,22 @@ let assumptions ?(add_opaque=false) ?(add_transparent=false) st gr t =
   let fold obj _ accu = match obj with
   | VarRef id ->
     let decl = Global.lookup_named id in
-    if is_local_assum decl then ContextObjectMap.add (Variable id) t accu
+    if is_local_assum decl then
+      let t = Context.Named.Declaration.get_type decl in
+      ContextObjectMap.add (Variable id) t accu
     else accu
   | ConstRef kn ->
-    let cb = lookup_constant kn in
-    if not (Declareops.constant_has_body cb) then
+      let cb = lookup_constant kn in
+      let accu =
+        if cb.const_typing_flags.check_guarded then accu
+        else
+          let l = try Refmap_env.find obj ax2ty with Not_found -> [] in
+          ContextObjectMap.add (Axiom (Guarded kn, l)) Constr.mkProp accu
+      in
+    if not (Declareops.constant_has_body cb) || not cb.const_typing_flags.check_universes then
       let t = type_of_constant cb in
       let l = try Refmap_env.find obj ax2ty with Not_found -> [] in
-      ContextObjectMap.add (Axiom (kn,l)) t accu
+      ContextObjectMap.add (Axiom (Constant kn,l)) t accu
     else if add_opaque && (Declareops.is_opaque cb || not (Cpred.mem kn knst)) then
       let t = type_of_constant cb in
       ContextObjectMap.add (Opaque kn) t accu
@@ -299,6 +309,12 @@ let assumptions ?(add_opaque=false) ?(add_transparent=false) st gr t =
       ContextObjectMap.add (Transparent kn) t accu
     else
       accu
-  | IndRef _ | ConstructRef _ -> accu
+  | IndRef (m,_) | ConstructRef ((m,_),_) ->
+      let mind = Global.lookup_mind m in
+      if mind.mind_typing_flags.check_guarded then
+        accu
+      else
+        let l = try Refmap_env.find obj ax2ty with Not_found -> [] in
+        ContextObjectMap.add (Axiom (Positive m, l)) Constr.mkProp accu
   in
   Refmap_env.fold fold graph ContextObjectMap.empty
diff --git a/toplevel/assumptions.mli b/vernac/assumptions.mli
index 072675783..072675783 100644
--- a/toplevel/assumptions.mli
+++ b/vernac/assumptions.mli
diff --git a/toplevel/auto_ind_decl.ml b/vernac/auto_ind_decl.ml
index 3d053c2e1..594f2e944 100644
--- a/toplevel/auto_ind_decl.ml
+++ b/vernac/auto_ind_decl.ml
@@ -10,7 +10,7 @@
    decidable equality, created by Vincent Siles, Oct 2007 *)
 
 open Tacmach
-open Errors
+open CErrors
 open Util
 open Pp
 open Term
@@ -25,7 +25,8 @@ open Tactics
 open Ind_tables
 open Misctypes
 open Proofview.Notations
-open Context.Rel.Declaration
+
+module RelDecl = Context.Rel.Declaration
 
 let out_punivs = Univ.out_punivs
 
@@ -54,9 +55,10 @@ exception EqUnknown of string
 exception UndefinedCst of string
 exception InductiveWithProduct
 exception InductiveWithSort
-exception ParameterWithoutEquality of constant
+exception ParameterWithoutEquality of global_reference
 exception NonSingletonProp of inductive
 exception DecidabilityMutualNotSupported
+exception NoDecidabilityCoInductive
 
 let dl = Loc.ghost
 
@@ -108,7 +110,7 @@ let mkFullInd (ind,u) n =
 
 let check_bool_is_defined () =
   try let _ = Global.type_of_global_unsafe Coqlib.glob_bool in ()
-  with e when Errors.noncritical e -> raise (UndefinedCst "bool")
+  with e when CErrors.noncritical e -> raise (UndefinedCst "bool")
 
 let beq_scheme_kind_aux = ref (fun _ -> failwith "Undefined")
 
@@ -150,14 +152,14 @@ let build_beq_scheme mode kn =
           ( fun a b decl -> (* mkLambda(n,b,a) ) *)
                 (* here I leave the Naming thingy so that the type of
                   the function is more readable for the user *)
-                mkNamedLambda (eqName (get_name decl)) b a )
+                mkNamedLambda (eqName (RelDecl.get_name decl)) b a )
                 c (List.rev eqs_typ) lnamesparrec
        in
         List.fold_left (fun a decl ->(* mkLambda(n,t,a)) eq_input rel_list *)
           (* Same here , hoping the auto renaming will do something good ;)  *)
           mkNamedLambda
-                (match get_name decl with Name s -> s | Anonymous ->  Id.of_string "A")
-                (get_type decl)  a) eq_input lnamesparrec
+                (match RelDecl.get_name decl with Name s -> s | Anonymous ->  Id.of_string "A")
+                (RelDecl.get_type decl)  a) eq_input lnamesparrec
  in
  let make_one_eq cur =
   let u = Univ.Instance.empty in
@@ -181,7 +183,13 @@ let build_beq_scheme mode kn =
 	let (c,a) = Reductionops.whd_betaiota_stack Evd.empty c in
 	match kind_of_term c with
         | Rel x -> mkRel (x-nlist+ndx), Safe_typing.empty_private_constants
-        | Var x -> mkVar (id_of_string ("eq_"^(string_of_id x))), Safe_typing.empty_private_constants
+        | Var x ->
+          let eid = id_of_string ("eq_"^(string_of_id x)) in
+          let () =
+            try ignore (Environ.lookup_named eid env)
+            with Not_found -> raise (ParameterWithoutEquality (VarRef x))
+          in
+          mkVar eid, Safe_typing.empty_private_constants
         | Cast (x,_,_) -> aux (applist (x,a))
         | App _ -> assert false
         | Ind ((kn',i as ind'),u) (*FIXME: universes *) -> 
@@ -205,19 +213,19 @@ let build_beq_scheme mode kn =
             end
         | Sort _  -> raise InductiveWithSort
         | Prod _ -> raise InductiveWithProduct
-        | Lambda _-> raise (EqUnknown "Lambda")
-        | LetIn _ -> raise (EqUnknown "LetIn")
+        | Lambda _-> raise (EqUnknown "abstraction")
+        | LetIn _ -> raise (EqUnknown "let-in")
         | Const kn ->
 	    (match Environ.constant_opt_value_in env kn with
-	      | None -> raise (ParameterWithoutEquality (fst kn))
+	      | None -> raise (ParameterWithoutEquality (ConstRef (fst kn)))
 	      | Some c -> aux (applist (c,a)))
-        | Proj _ -> raise (EqUnknown "Proj")
-        | Construct _ -> raise (EqUnknown "Construct")
-        | Case _ -> raise (EqUnknown "Case")
-        | CoFix _ -> raise (EqUnknown "CoFix")
-        | Fix _   -> raise (EqUnknown "Fix")
-        | Meta _  -> raise (EqUnknown "Meta")
-        | Evar _  -> raise (EqUnknown "Evar")
+        | Proj _ -> raise (EqUnknown "projection")
+        | Construct _ -> raise (EqUnknown "constructor")
+        | Case _ -> raise (EqUnknown "match")
+        | CoFix _ -> raise (EqUnknown "cofix")
+        | Fix _   -> raise (EqUnknown "fix")
+        | Meta _  -> raise (EqUnknown "meta-variable")
+        | Evar _  -> raise (EqUnknown "existential variable")
     in
       aux t
   in
@@ -249,7 +257,7 @@ let build_beq_scheme mode kn =
                     | 0 -> Lazy.force tt
                     | _ -> let eqs = Array.make nb_cstr_args (Lazy.force tt) in
                       for ndx = 0 to nb_cstr_args-1 do
-                        let cc = get_type (List.nth constrsi.(i).cs_args ndx) in
+                        let cc = RelDecl.get_type (List.nth constrsi.(i).cs_args ndx) in
                           let eqA, eff' = compute_A_equality rel_list
                                           nparrec
                                           (nparrec+3+2*nb_cstr_args)
@@ -268,14 +276,14 @@ let build_beq_scheme mode kn =
                           (Array.sub eqs 1 (nb_cstr_args - 1))
                   )
    		  in
-		    (List.fold_left (fun a decl -> mkLambda (get_name decl, get_type decl, a)) cc
+		    (List.fold_left (fun a decl -> mkLambda (RelDecl.get_name decl, RelDecl.get_type decl, a)) cc
                     (constrsj.(j).cs_args)
 		)
 	      else ar2.(j) <- (List.fold_left (fun a decl ->
-			mkLambda (get_name decl, get_type decl, a)) (Lazy.force ff) (constrsj.(j).cs_args) )
+			mkLambda (RelDecl.get_name decl, RelDecl.get_type decl, a)) (Lazy.force ff) (constrsj.(j).cs_args) )
 	    done;
 
-	  ar.(i) <- (List.fold_left (fun a decl -> mkLambda (get_name decl, get_type decl, a))
+	  ar.(i) <- (List.fold_left (fun a decl -> mkLambda (RelDecl.get_name decl, RelDecl.get_type decl, a))
 			(mkCase (ci,do_predicate rel_list nb_cstr_args,
 				  mkVar (Id.of_string "Y") ,ar2))
 			 (constrsi.(i).cs_args))
@@ -302,6 +310,8 @@ let build_beq_scheme mode kn =
       let kelim = Inductive.elim_sorts (mib,mib.mind_packets.(i)) in
 	if not (Sorts.List.mem InSet kelim) then
 	  raise (NonSingletonProp (kn,i));
+        if mib.mind_finite = Decl_kinds.CoFinite then
+	  raise NoDecidabilityCoInductive;
         let fix = mkFix (((Array.make nb_ind 0),i),(names,types,cores)) in
         create_input fix),
        Evd.make_evar_universe_context (Global.env ()) None),
@@ -340,11 +350,11 @@ let do_replace_lb mode lb_scheme_key aavoid narg p q =
     let rec find i =
       if Id.equal avoid.(n-i) s then avoid.(n-i-x)
       else (if i<n then find (i+1)
-            else errorlabstrm "AutoIndDecl.do_replace_lb"
+            else user_err ~hdr:"AutoIndDecl.do_replace_lb"
                    (str "Var " ++ pr_id s ++ str " seems unknown.")
       )
     in mkVar (find 1)
-  with e when Errors.noncritical e ->
+  with e when CErrors.noncritical e ->
       (* if this happen then the args have to be already declared as a
               Parameter*)
       (
@@ -398,11 +408,11 @@ let do_replace_bl mode bl_scheme_key (ind,u as indu) aavoid narg lft rgt =
     let rec find i =
       if Id.equal avoid.(n-i) s then avoid.(n-i-x)
       else (if i<n then find (i+1)
-            else errorlabstrm "AutoIndDecl.do_replace_bl"
+            else user_err ~hdr:"AutoIndDecl.do_replace_bl"
                    (str "Var " ++ pr_id s ++ str " seems unknown.")
       )
     in mkVar (find 1)
-  with e when Errors.noncritical e ->
+  with e when CErrors.noncritical e ->
       (* if this happen then the args have to be already declared as a
          Parameter*)
       (
@@ -423,7 +433,7 @@ let do_replace_bl mode bl_scheme_key (ind,u as indu) aavoid narg lft rgt =
         else (
           let u,v = try  destruct_ind tt1
           (* trick so that the good sequence is returned*)
-                with e when Errors.noncritical e -> indu,[||]
+                with e when CErrors.noncritical e -> indu,[||]
           in if eq_ind (fst u) ind
              then Tacticals.New.tclTHENLIST [Equality.replace t1 t2; Auto.default_auto ; aux q1 q2 ]
              else (
@@ -489,7 +499,7 @@ let do_replace_bl mode bl_scheme_key (ind,u as indu) aavoid narg lft rgt =
   [(in,eq_in,in_bl,in_al),,...,(i1,eq_i1,i1_bl_i1_al  )]
 *)
 let list_id l = List.fold_left ( fun a decl -> let s' =
-      match get_name decl with
+      match RelDecl.get_name decl with
         Name s -> Id.to_string s
       | Anonymous -> "A" in
           (Id.of_string s',Id.of_string ("eq_"^s'),
@@ -506,19 +516,22 @@ let eqI ind l =
                            (List.map (fun (_,seq,_,_)-> mkVar seq) list_id ))
   and e, eff = 
     try let c, eff = find_scheme beq_scheme_kind ind in mkConst c, eff 
-    with Not_found -> errorlabstrm "AutoIndDecl.eqI"
+    with Not_found -> user_err ~hdr:"AutoIndDecl.eqI"
       (str "The boolean equality on " ++ pr_mind (fst ind) ++ str " is needed.");
   in (if Array.equal eq_constr eA [||] then e else mkApp(e,eA)), eff
 
 (**********************************************************************)
 (* Boolean->Leibniz *)
 
+open Namegen
+
 let compute_bl_goal ind lnamesparrec nparrec =
   let eqI, eff = eqI ind lnamesparrec in
   let list_id = list_id lnamesparrec in
+  let avoid = List.fold_right (Nameops.name_fold (fun id l -> id::l)) (List.map RelDecl.get_name lnamesparrec) [] in
   let create_input c =
-    let x = Id.of_string "x" and
-        y = Id.of_string "y" in
+    let x = next_ident_away (Id.of_string "x") avoid and
+        y = next_ident_away (Id.of_string "y") avoid in
       let bl_typ = List.map (fun (s,seq,_,_) ->
         mkNamedProd x (mkVar s) (
             mkNamedProd y (mkVar s) (
@@ -537,11 +550,11 @@ let compute_bl_goal ind lnamesparrec nparrec =
         mkNamedProd seq b a
       ) bl_input (List.rev list_id) (List.rev eqs_typ) in
       List.fold_left (fun a decl -> mkNamedProd
-                (match get_name decl with Name s -> s | Anonymous ->  Id.of_string "A")
-                (get_type decl) a) eq_input lnamesparrec
+                (match RelDecl.get_name decl with Name s -> s | Anonymous -> next_ident_away (Id.of_string "A") avoid)
+                (RelDecl.get_type decl) a) eq_input lnamesparrec
     in
-      let n = Id.of_string "x" and
-          m = Id.of_string "y" in
+      let n = next_ident_away (Id.of_string "x") avoid and
+          m = next_ident_away (Id.of_string "y") avoid in
       let u = Univ.Instance.empty in
      create_input (
         mkNamedProd n (mkFullInd (ind,u) nparrec) (
@@ -633,7 +646,7 @@ let side_effect_of_mode = function
 let make_bl_scheme mode mind =
   let mib = Global.lookup_mind mind in
   if not (Int.equal (Array.length mib.mind_packets) 1) then
-    errorlabstrm ""
+    user_err 
       (str "Automatic building of boolean->Leibniz lemmas not supported");
   let ind = (mind,0) in
   let nparams = mib.mind_nparams in
@@ -658,10 +671,11 @@ let _ = bl_scheme_kind_aux := fun () -> bl_scheme_kind
 let compute_lb_goal ind lnamesparrec nparrec =
   let list_id = list_id lnamesparrec in
   let eq = Lazy.force eq and tt = Lazy.force tt and bb = Lazy.force bb in
+  let avoid = List.fold_right (Nameops.name_fold (fun id l -> id::l)) (List.map RelDecl.get_name lnamesparrec) [] in
   let eqI, eff = eqI ind lnamesparrec in
     let create_input c =
-      let x = Id.of_string "x" and
-          y = Id.of_string "y" in
+      let x = next_ident_away (Id.of_string "x") avoid and
+          y = next_ident_away (Id.of_string "y") avoid in
       let lb_typ = List.map (fun (s,seq,_,_) ->
         mkNamedProd x (mkVar s) (
             mkNamedProd y (mkVar s) (
@@ -680,11 +694,11 @@ let compute_lb_goal ind lnamesparrec nparrec =
         mkNamedProd seq b a
       ) lb_input (List.rev list_id) (List.rev eqs_typ) in
       List.fold_left (fun a decl -> mkNamedProd
-                (match (get_name decl) with Name s -> s | Anonymous ->  Id.of_string "A")
-                (get_type decl)  a) eq_input lnamesparrec
+                (match (RelDecl.get_name decl) with Name s -> s | Anonymous ->  Id.of_string "A")
+                (RelDecl.get_type decl)  a) eq_input lnamesparrec
     in
-      let n = Id.of_string "x" and
-          m = Id.of_string "y" in
+      let n = next_ident_away (Id.of_string "x") avoid and
+          m = next_ident_away (Id.of_string "y") avoid in
       let u = Univ.Instance.empty in
       create_input (
         mkNamedProd n (mkFullInd (ind,u) nparrec) (
@@ -756,7 +770,7 @@ let lb_scheme_kind_aux = ref (fun () -> failwith "Undefined")
 let make_lb_scheme mode mind =
   let mib = Global.lookup_mind mind in
   if not (Int.equal (Array.length mib.mind_packets) 1) then
-    errorlabstrm ""
+    user_err 
       (str "Automatic building of Leibniz->boolean lemmas not supported");
   let ind = (mind,0) in
   let nparams = mib.mind_nparams in
@@ -780,16 +794,17 @@ let _ = lb_scheme_kind_aux := fun () -> lb_scheme_kind
 
 let check_not_is_defined () =
   try ignore (Coqlib.build_coq_not ())
-  with e when Errors.noncritical e -> raise (UndefinedCst "not")
+  with e when CErrors.noncritical e -> raise (UndefinedCst "not")
 
 (* {n=m}+{n<>m}  part  *)
 let compute_dec_goal ind lnamesparrec nparrec =
   check_not_is_defined ();
   let eq = Lazy.force eq and tt = Lazy.force tt and bb = Lazy.force bb in
   let list_id = list_id lnamesparrec in
+  let avoid = List.fold_right (Nameops.name_fold (fun id l -> id::l)) (List.map RelDecl.get_name lnamesparrec) [] in
     let create_input c =
-      let x = Id.of_string "x" and
-          y = Id.of_string "y" in
+      let x = next_ident_away (Id.of_string "x") avoid and
+          y = next_ident_away (Id.of_string "y") avoid in
       let lb_typ = List.map (fun (s,seq,_,_) ->
         mkNamedProd x (mkVar s) (
             mkNamedProd y (mkVar s) (
@@ -821,11 +836,11 @@ let compute_dec_goal ind lnamesparrec nparrec =
         mkNamedProd seq b a
       ) bl_input (List.rev list_id) (List.rev eqs_typ) in
       List.fold_left (fun a decl -> mkNamedProd
-                (match get_name decl with Name s -> s | Anonymous ->  Id.of_string "A")
-                (get_type decl) a) eq_input lnamesparrec
+                (match RelDecl.get_name decl with Name s -> s | Anonymous ->  Id.of_string "A")
+                (RelDecl.get_type decl) a) eq_input lnamesparrec
     in
-      let n = Id.of_string "x" and
-          m = Id.of_string "y" in
+      let n = next_ident_away (Id.of_string "x") avoid and
+          m = next_ident_away (Id.of_string "y") avoid in
         let eqnm = mkApp(eq,[|mkFullInd ind (2*nparrec+2);mkVar n;mkVar m|]) in
         create_input (
           mkNamedProd n (mkFullInd ind (2*nparrec)) (
diff --git a/toplevel/auto_ind_decl.mli b/vernac/auto_ind_decl.mli
index b6c66a1e8..60232ba8f 100644
--- a/toplevel/auto_ind_decl.mli
+++ b/vernac/auto_ind_decl.mli
@@ -21,9 +21,10 @@ exception EqUnknown of string
 exception UndefinedCst of string
 exception InductiveWithProduct
 exception InductiveWithSort
-exception ParameterWithoutEquality of constant
+exception ParameterWithoutEquality of Globnames.global_reference
 exception NonSingletonProp of inductive
 exception DecidabilityMutualNotSupported
+exception NoDecidabilityCoInductive
 
 val beq_scheme_kind : mutual scheme_kind
 val build_beq_scheme : mutual_scheme_object_function
diff --git a/toplevel/class.ml b/vernac/class.ml
index 10e9b30be..0dc799014 100644
--- a/toplevel/class.ml
+++ b/vernac/class.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-open Errors
+open CErrors
 open Util
 open Pp
 open Names
@@ -32,7 +32,6 @@ type coercion_error_kind =
   | NotAFunction
   | NoSource of cl_typ option
   | ForbiddenSourceClass of cl_typ
-  | NotUniform
   | NoTarget
   | WrongTarget of cl_typ * cl_typ
   | NotAClass of global_reference
@@ -51,9 +50,6 @@ let explain_coercion_error g = function
       (str ": cannot find the source class of " ++ Printer.pr_global g)
   | ForbiddenSourceClass cl ->
       pr_class cl ++ str " cannot be a source class"
-  | NotUniform ->
-      (Printer.pr_global g ++
-         str" does not respect the uniform inheritance condition");
   | NoTarget ->
       (str"Cannot find the target class")
   | WrongTarget (clt,cl) ->
@@ -102,7 +98,7 @@ let class_of_global = function
   | IndRef sp -> CL_IND sp
   | VarRef id -> CL_SECVAR id
   | ConstructRef _ as c ->
-      errorlabstrm "class_of_global"
+      user_err ~hdr:"class_of_global"
 	(str "Constructors, such as " ++ Printer.pr_global c ++
 	   str ", cannot be used as a class.")
 
@@ -181,7 +177,7 @@ let ident_key_of_class = function
 (* Identity coercion *)
 
 let error_not_transparent source =
-  errorlabstrm "build_id_coercion"
+  user_err ~hdr:"build_id_coercion"
     (pr_class source ++ str " must be a transparent constant.")
 
 let build_id_coercion idf_opt source poly =
@@ -212,7 +208,7 @@ let build_id_coercion idf_opt source poly =
       (Reductionops.is_conv_leq env sigma
 	(Typing.unsafe_type_of env sigma val_f) typ_f)
     then
-      errorlabstrm "" (strbrk
+      user_err  (strbrk
 	"Cannot be defined as coercion (maybe a bad number of arguments).")
   in
   let idf =
@@ -247,6 +243,12 @@ booleen "coercion identite'?"
 lorque source est None alors target est None aussi.
 *)
 
+let warn_uniform_inheritance =
+  CWarnings.create ~name:"uniform-inheritance" ~category:"typechecker"
+         (fun g ->
+          Printer.pr_global g ++
+            strbrk" does not respect the uniform inheritance condition")
+
 let add_new_coercion_core coef stre poly source target isid =
   check_source source;
   let t = Global.type_of_global_unsafe coef in
@@ -262,7 +264,7 @@ let add_new_coercion_core coef stre poly source target isid =
   in
   check_source (Some cls);
   if not (uniform_cond (llp-ind) lvs) then
-    Feedback.msg_warning (explain_coercion_error coef NotUniform);
+    warn_uniform_inheritance coef;
   let clt =
     try
       get_target tg ind
@@ -282,7 +284,7 @@ let add_new_coercion_core coef stre poly source target isid =
 let try_add_new_coercion_core ref ~local c d e f =
   try add_new_coercion_core ref (loc_of_bool local) c d e f
   with CoercionError e ->
-      errorlabstrm "try_add_new_coercion_core"
+      user_err ~hdr:"try_add_new_coercion_core"
         (explain_coercion_error ref e ++ str ".")
 
 let try_add_new_coercion ref ~local poly =
diff --git a/toplevel/class.mli b/vernac/class.mli
index 5f9ae28f6..5f9ae28f6 100644
--- a/toplevel/class.mli
+++ b/vernac/class.mli
diff --git a/toplevel/classes.ml b/vernac/classes.ml
index 235732b52..6512f3def 100644
--- a/toplevel/classes.ml
+++ b/vernac/classes.ml
@@ -12,7 +12,7 @@ open Term
 open Vars
 open Environ
 open Nametab
-open Errors
+open CErrors
 open Util
 open Typeclasses_errors
 open Typeclasses
@@ -22,6 +22,8 @@ open Constrintern
 open Constrexpr
 open Sigma.Notations
 open Context.Rel.Declaration
+
+module RelDecl = Context.Rel.Declaration
 (*i*)
 
 open Decl_kinds
@@ -46,28 +48,38 @@ let set_typeclass_transparency c local b =
     
 let _ =
   Hook.set Typeclasses.add_instance_hint_hook
-    (fun inst path local pri poly ->
+    (fun inst path local info poly ->
      let inst' = match inst with IsConstr c -> Hints.IsConstr (c, Univ.ContextSet.empty)
        | IsGlobal gr -> Hints.IsGlobRef gr
      in
-      Flags.silently (fun () ->
+     let info =
+       let open Vernacexpr in
+       { info with hint_pattern =
+		   Option.map
+		     (Constrintern.intern_constr_pattern (Global.env()))
+		     info.hint_pattern } in
+     Flags.silently (fun () ->
 	Hints.add_hints local [typeclasses_db]
 	  (Hints.HintsResolveEntry
-	     [pri, poly, false, Hints.PathHints path, inst'])) ());
+	     [info, poly, false, Hints.PathHints path, inst'])) ());
   Hook.set Typeclasses.set_typeclass_transparency_hook set_typeclass_transparency;
   Hook.set Typeclasses.classes_transparent_state_hook
     (fun () -> Hints.Hint_db.transparent_state (Hints.searchtable_map typeclasses_db))
-        
+
+open Vernacexpr
+
 (** TODO: add subinstances *)
-let existing_instance glob g pri =
+let existing_instance glob g info =
   let c = global g in
+  let info = Option.default Hints.empty_hint_info info in
   let instance = Global.type_of_global_unsafe c in
   let _, r = decompose_prod_assum instance in
     match class_of_constr r with
-      | Some (_, ((tc,u), _)) -> add_instance (new_instance tc pri glob 
+      | Some (_, ((tc,u), _)) -> add_instance (new_instance tc info glob
   (*FIXME*) (Flags.use_polymorphic_flag ()) c)
-      | None -> user_err_loc (loc_of_reference g, "declare_instance",
-			     Pp.str "Constant does not build instances of a declared type class.")
+      | None -> user_err ~loc:(loc_of_reference g)
+                         ~hdr:"declare_instance"
+                         (Pp.str "Constant does not build instances of a declared type class.")
 
 let mismatched_params env n m = mismatched_ctx_inst env Parameters n m
 let mismatched_props env n m = mismatched_ctx_inst env Properties n m
@@ -77,13 +89,13 @@ let mismatched_props env n m = mismatched_ctx_inst env Properties n m
 let type_ctx_instance evars env ctx inst subst =
   let rec aux (subst, instctx) l = function
     decl :: ctx ->
-      let t' = substl subst (get_type decl) in
+      let t' = substl subst (RelDecl.get_type decl) in
       let c', l =
 	match decl with
 	| LocalAssum _ -> interp_casted_constr_evars env evars (List.hd l) t', List.tl l
 	| LocalDef (_,b,_) -> substl subst b, l
       in
-      let d = get_name decl, Some c', t' in
+      let d = RelDecl.get_name decl, Some c', t' in
 	aux (c' :: subst, d :: instctx) l ctx
     | [] -> subst
   in aux (subst, []) inst (List.rev ctx)
@@ -98,12 +110,12 @@ let id_of_class cl =
 
 open Pp
 
-let instance_hook k pri global imps ?hook cst =
+let instance_hook k info global imps ?hook cst =
   Impargs.maybe_declare_manual_implicits false cst ~enriching:false imps;
-  Typeclasses.declare_instance pri (not global) cst;
+  Typeclasses.declare_instance (Some info) (not global) cst;
   (match hook with Some h -> h cst | None -> ())
 
-let declare_instance_constant k pri global imps ?hook id pl poly evm term termtype =
+let declare_instance_constant k info global imps ?hook id pl poly evm term termtype =
   let kind = IsDefinition Instance in
   let evm = 
     let levels = Univ.LSet.union (Universes.universes_of_constr termtype) 
@@ -118,7 +130,7 @@ let declare_instance_constant k pri global imps ?hook id pl poly evm term termty
   let kn = Declare.declare_constant id cdecl in
     Declare.definition_message id;
     Universes.register_universe_binders (ConstRef kn) pl;
-    instance_hook k pri global imps ?hook (ConstRef kn);
+    instance_hook k info global imps ?hook (ConstRef kn);
     id
 
 let new_instance ?(abstract=false) ?(global=false) ?(refine= !refine_instance) poly ctx (instid, bk, cl) props
@@ -130,7 +142,7 @@ let new_instance ?(abstract=false) ?(global=false) ?(refine= !refine_instance) p
   let evars = ref (Evd.from_ctx uctx) in
   let tclass, ids =
     match bk with
-    | Implicit ->
+    | Decl_kinds.Implicit ->
 	Implicit_quantifiers.implicit_application Id.Set.empty ~allow_partial:false
 	  (fun avoid (clname, _) ->
 	    match clname with
@@ -156,7 +168,6 @@ let new_instance ?(abstract=false) ?(global=false) ?(refine= !refine_instance) p
     let cl, u = Typeclasses.typeclass_univ_instance k in
     let _, args = 
       List.fold_right (fun decl (args, args') ->
-        let open Context.Rel.Declaration in
 	match decl with
 	| LocalAssum _ -> (List.tl args, List.hd args :: args')
 	| LocalDef (_,b,_) -> (args, substl args' b :: args'))
@@ -169,7 +180,7 @@ let new_instance ?(abstract=false) ?(global=false) ?(refine= !refine_instance) p
 	Name id ->
 	  let sp = Lib.make_path id in
 	    if Nametab.exists_cci sp then
-	      errorlabstrm "new_instance" (Nameops.pr_id id ++ Pp.str " already exists.");
+	      user_err ~hdr:"new_instance" (Nameops.pr_id id ++ Pp.str " already exists.");
 	    id
       | Anonymous ->
 	  let i = Nameops.add_suffix (id_of_class k) "_instance_0" in
@@ -229,7 +240,7 @@ let new_instance ?(abstract=false) ?(global=false) ?(refine= !refine_instance) p
 		(fun (props, rest) decl ->
 		  if is_local_assum decl then
 		    try
-		      let is_id (id', _) = match get_name decl, get_id id' with
+		      let is_id (id', _) = match RelDecl.get_name decl, get_id id' with
 			| Name id, (_, id') -> Id.equal id id'
 			| Anonymous, _ -> false
                       in
@@ -299,7 +310,7 @@ let new_instance ?(abstract=false) ?(global=false) ?(refine= !refine_instance) p
 	      let hook vis gr _ =
 		let cst = match gr with ConstRef kn -> kn | _ -> assert false in
 		  Impargs.declare_manual_implicits false gr ~enriching:false [imps];
-		  Typeclasses.declare_instance pri (not global) (ConstRef cst)
+		  Typeclasses.declare_instance (Some pri) (not global) (ConstRef cst)
 	      in
 	      let obls, constr, typ =
 		match term with 
@@ -341,13 +352,13 @@ let new_instance ?(abstract=false) ?(global=false) ?(refine= !refine_instance) p
 		(match tac with Some tac -> ignore (Pfedit.by tac) | None -> ())) ();
 	       id)
 	end
-      else Errors.error "Unsolved obligations remaining.")
+      else CErrors.error "Unsolved obligations remaining.")
 	
 let named_of_rel_context l =
   let acc, ctx =
     List.fold_right
       (fun decl (subst, ctx) ->
-        let id = match get_name decl with Anonymous -> invalid_arg "named_of_rel_context" | Name id -> id in
+        let id = match RelDecl.get_name decl with Anonymous -> invalid_arg "named_of_rel_context" | Name id -> id in
 	let d = match decl with
 	  | LocalAssum (_,t) -> id, None, substl subst t
 	  | LocalDef (_,b,t) -> id, Some (substl subst b), substl subst t in
@@ -365,7 +376,7 @@ let context poly l =
   let () = List.iter (fun decl -> Context.Rel.Declaration.iter_constr ce decl) fullctx in
   let ctx =
     try named_of_rel_context fullctx
-    with e when Errors.noncritical e ->
+    with e when CErrors.noncritical e ->
       error "Anonymous variables not allowed in contexts."
   in
   let uctx = ref (Evd.universe_context_set !evars) in
@@ -378,7 +389,7 @@ let context poly l =
       let cst = Declare.declare_constant ~internal:Declare.InternalTacticRequest id decl in
 	match class_of_constr t with
 	| Some (rels, ((tc,_), args) as _cl) ->
-	    add_instance (Typeclasses.new_instance tc None false (*FIXME*)
+	    add_instance (Typeclasses.new_instance tc Hints.empty_hint_info false (*FIXME*)
 			    poly (ConstRef cst));
             status
 	    (* declare_subclasses (ConstRef cst) cl *)
diff --git a/toplevel/classes.mli b/vernac/classes.mli
index 7beb873e6..d2cb788ea 100644
--- a/toplevel/classes.mli
+++ b/vernac/classes.mli
@@ -20,12 +20,12 @@ val mismatched_props : env -> constr_expr list -> Context.Rel.t -> 'a
 
 (** Instance declaration *)
 
-val existing_instance : bool -> reference -> int option -> unit
-(** globality, reference, priority *)
+val existing_instance : bool -> reference -> Vernacexpr.hint_info_expr option -> unit
+(** globality, reference, optional priority and pattern information *)
 
 val declare_instance_constant :
   typeclass ->
-  int option -> (** priority *)
+  Vernacexpr.hint_info_expr -> (** priority *)
   bool -> (** globality *)
   Impargs.manual_explicitation list -> (** implicits *)
   ?hook:(Globnames.global_reference -> unit) ->
@@ -48,7 +48,7 @@ val new_instance :
   ?generalize:bool ->
   ?tac:unit Proofview.tactic  ->
   ?hook:(Globnames.global_reference -> unit) ->
-  int option ->
+  Vernacexpr.hint_info_expr ->
   Id.t
 
 (** Setting opacity *)
diff --git a/toplevel/command.ml b/vernac/command.ml
index f0f678e08..049f58aa2 100644
--- a/toplevel/command.ml
+++ b/vernac/command.ml
@@ -7,7 +7,7 @@
 (************************************************************************)
 
 open Pp
-open Errors
+open CErrors
 open Util
 open Flags
 open Term
@@ -39,6 +39,8 @@ open Sigma.Notations
 open Context.Rel.Declaration
 open Entries
 
+module RelDecl = Context.Rel.Declaration
+
 let do_universe poly l = Declare.do_universe poly l
 let do_constraint poly l = Declare.do_constraint poly l
 
@@ -57,8 +59,8 @@ let rec complete_conclusion a cs = function
   | CHole (loc, k, _, _) ->
       let (has_no_args,name,params) = a in
       if not has_no_args then
-	user_err_loc (loc,"",
-	  strbrk"Cannot infer the non constant arguments of the conclusion of "
+	user_err ~loc 
+	 (strbrk"Cannot infer the non constant arguments of the conclusion of "
 	  ++ pr_id cs ++ str ".");
       let args = List.map (fun id -> CRef(Ident(loc,id),None)) params in
       CAppExpl (loc,(None,Ident(loc,name),None),List.rev args)
@@ -82,6 +84,12 @@ let red_constant_entry n ce sigma = function
       { ce with const_entry_body = Future.chain ~greedy:true ~pure:true proof_out
         (fun ((body,ctx),eff) -> (under_binders env sigma redfun n body,ctx),eff) }
 
+let warn_implicits_in_term =
+  CWarnings.create ~name:"implicits-in-term" ~category:"implicits"
+         (fun () ->
+          strbrk "Implicit arguments declaration relies on type." ++ spc () ++
+            strbrk "The term declares more implicits than the type here.")
+        
 let interp_definition pl bl p red_option c ctypopt =
   let env = Global.env() in
   let ctx = Evd.make_evar_universe_context env pl in
@@ -119,9 +127,7 @@ let interp_definition pl bl p red_option c ctypopt =
           impl_eq (List.assoc_f Pervasives.(=) key impsty) va (* FIXME *)
         in
 	if not (try List.for_all chk imps2 with Not_found -> false)
-	then Feedback.msg_warning
-          (strbrk "Implicit arguments declaration relies on type." ++ spc () ++
-	   strbrk "The term declares more implicits than the type here.");
+	then warn_implicits_in_term ();
         let vars = Univ.LSet.union (Universes.universes_of_constr body) 
           (Universes.universes_of_constr typ) in
         let ctx = Evd.restrict_universe_context !evdref vars in
@@ -136,17 +142,21 @@ let check_definition (ce, evd, _, imps) =
   check_evars_are_solved (Global.env ()) evd (Evd.empty,evd);
   ce
 
-let get_locality id = function
+let warn_local_declaration =
+  CWarnings.create ~name:"local-declaration" ~category:"scope"
+         (fun (id,kind) ->
+          pr_id id ++ strbrk " is declared as a local " ++ str kind)
+
+let get_locality id ~kind = function
 | Discharge ->
   (** If a Let is defined outside a section, then we consider it as a local definition *)
-  let msg = pr_id id ++ strbrk " is declared as a local definition" in
-  let () = Feedback.msg_warning msg in
+   warn_local_declaration (id,kind);
   true
 | Local -> true
 | Global -> false
 
 let declare_global_definition ident ce local k pl imps =
-  let local = get_locality ident local in
+  let local = get_locality ident ~kind:"definition" local in
   let kn = declare_constant ident ~local (DefinitionEntry ce, IsDefinition k) in
   let gr = ConstRef kn in
   let () = maybe_declare_manual_implicits false gr imps in
@@ -158,6 +168,12 @@ let declare_definition_hook = ref ignore
 let set_declare_definition_hook = (:=) declare_definition_hook
 let get_declare_definition_hook () = !declare_definition_hook
 
+let warn_definition_not_visible =
+  CWarnings.create ~name:"definition-not-visible" ~category:"implicits"
+         (fun ident ->
+          strbrk "Section definition " ++
+            pr_id ident ++ strbrk " is not visible from current goals")
+
 let declare_definition ident (local, p, k) ce pl imps hook =
   let fix_exn = Future.fix_exn_of ce.const_entry_body in
   let () = !declare_definition_hook ce in
@@ -169,9 +185,7 @@ let declare_definition ident (local, p, k) ce pl imps hook =
     let gr = VarRef ident in
     let () = maybe_declare_manual_implicits false gr imps in
     let () = if Pfedit.refining () then
-      let msg = strbrk "Section definition " ++
-        pr_id ident ++ strbrk " is not visible from current goals" in
-      Feedback.msg_warning msg
+	       warn_definition_not_visible ident
     in
     gr
   | Discharge | Local | Global ->
@@ -217,7 +231,7 @@ match local with
   let () = assumption_message ident in
   let () =
     if is_verbose () && Pfedit.refining () then
-    Feedback.msg_warning (str"Variable" ++ spc () ++ pr_id ident ++
+    Feedback.msg_info (str"Variable" ++ spc () ++ pr_id ident ++
     strbrk " is not visible from current goals")
   in
   let r = VarRef ident in
@@ -226,7 +240,7 @@ match local with
   (r,Univ.Instance.empty,true)
 
 | Global | Local | Discharge ->
-  let local = get_locality ident local in
+  let local = get_locality ident ~kind:"axiom" local in
   let inl = match nl with
     | NoInline -> None
     | DefaultInline -> Some (Flags.get_inline_level())
@@ -249,10 +263,7 @@ match local with
 
 let interp_assumption evdref env impls bl c =
   let c = prod_constr_expr c bl in
-  let ty, impls = interp_type_evars_impls env evdref ~impls c in
-  let evd, nf = nf_evars_and_universes !evdref in
-  let ctx = Evd.universe_context_set evd in
-    ((nf ty, ctx), impls)
+  interp_type_evars_impls env evdref ~impls c
 
 let declare_assumptions idl is_coe k (c,ctx) pl imps impl_is_on nl =
   let refs, status, _ =
@@ -277,26 +288,32 @@ let do_assumptions_unbound_univs (_, poly, _ as kind) nl l =
         l []
     else l
   in
+  (* We intepret all declarations in the same evar_map, i.e. as a telescope. *)
   let _,l = List.fold_map (fun (env,ienv) (is_coe,(idl,c)) ->
-    let (t,ctx),imps = interp_assumption evdref env ienv [] c in
+    let t,imps = interp_assumption evdref env ienv [] c in
     let env =
       push_named_context (List.map (fun (_,id) -> LocalAssum (id,t)) idl) env in
     let ienv = List.fold_right (fun (_,id) ienv ->
       let impls = compute_internalization_data env Variable t imps in
       Id.Map.add id impls ienv) idl ienv in
-      ((env,ienv),((is_coe,idl),t,(ctx,imps)))) 
+      ((env,ienv),((is_coe,idl),t,imps))) 
     (env,empty_internalization_env) l
   in
   let evd = solve_remaining_evars all_and_fail_flags env !evdref (Evd.empty,!evdref) in
+  (* The universe constraints come from the whole telescope. *)
+  let evd = Evd.nf_constraints evd in
+  let ctx = Evd.universe_context_set evd in
   let l = List.map (on_pi2 (nf_evar evd)) l in
-  snd (List.fold_left (fun (subst,status) ((is_coe,idl),t,(ctx,imps)) ->
+  pi2 (List.fold_left (fun (subst,status,ctx) ((is_coe,idl),t,imps) ->
     let t = replace_vars subst t in
     let (refs,status') = declare_assumptions idl is_coe kind (t,ctx) [] imps false nl in
     let subst' = List.map2 
       (fun (_,id) (c,u) -> (id,Universes.constr_of_global_univ (c,u)))
       idl refs 
     in
-      (subst'@subst, status' && status)) ([],true) l)
+    (subst'@subst, status' && status,
+     (* The universe constraints are declared with the first declaration only. *)
+     Univ.ContextSet.empty)) ([],true,ctx) l)
 
 let do_assumptions_bound_univs coe kind nl id pl c =
   let env = Global.env () in
@@ -318,7 +335,7 @@ let do_assumptions kind nl l = match l with
   | (Discharge, _, _) when Lib.sections_are_opened () ->
     let loc = fst id in
     let msg = Pp.str "Section variables cannot be polymorphic." in
-    user_err_loc (loc, "", msg)
+    user_err ~loc  msg
   | _ -> ()
   in
   do_assumptions_bound_univs coe kind nl id (Some pl) c
@@ -330,7 +347,7 @@ let do_assumptions kind nl l = match l with
       let loc = fst id in
       let msg =
 	Pp.str "Assumptions with bound universes can only be defined one at a time." in
-      user_err_loc (loc, "", msg)
+      user_err ~loc  msg
     in
     (coe, (List.map map idl, c))
   in
@@ -426,7 +443,7 @@ let interp_ind_arity env evdref ind =
   let t, impls = understand_tcc_evars env evdref ~expected_type:IsType c, imps in
   let pseudo_poly = check_anonymous_type c in
   let () = if not (Reduction.is_arity env t) then
-    user_err_loc (constr_loc ind.ind_arity, "", str "Not an arity")
+    user_err ~loc:(constr_loc ind.ind_arity) (str "Not an arity")
   in
     t, pseudo_poly, impls
 
@@ -444,8 +461,8 @@ let sign_level env evd sign =
       match d with
       | LocalDef _ -> lev, push_rel d env
       | LocalAssum _ ->
-	let s = destSort (Reduction.whd_betadeltaiota env 
-			    (nf_evar evd (Retyping.get_type_of env evd (get_type d))))
+	let s = destSort (Reduction.whd_all env 
+			    (nf_evar evd (Retyping.get_type_of env evd (RelDecl.get_type d))))
 	in
 	let u = univ_of_sort s in
 	  (Univ.sup u lev, push_rel d env))
@@ -525,11 +542,9 @@ let inductive_levels env evdref poly arities inds =
 	in
 	let duu = Sorts.univ_of_sort du in
 	let evd =
-	  if not (Univ.is_small_univ duu) && Evd.check_eq evd cu duu then
-	    if is_flexible_sort evd duu then
-	      if Evd.check_leq evd Univ.type0_univ duu then
-	      	evd
-	      else Evd.set_eq_sort env evd (Prop Null) du
+	  if not (Univ.is_small_univ duu) && Univ.Universe.equal cu duu then
+	    if is_flexible_sort evd duu && not (Evd.check_leq evd Univ.type0_univ duu) then
+	      Evd.set_eq_sort env evd (Prop Null) du
 	    else evd
 	  else Evd.set_eq_sort env evd (Type cu) du
 	in
@@ -541,13 +556,14 @@ let check_named (loc, na) = match na with
 | Name _ -> ()
 | Anonymous ->
   let msg = str "Parameters must be named." in
-  user_err_loc (loc, "", msg)
+  user_err ~loc  msg
 
 
 let check_param = function
 | LocalRawDef (na, _) -> check_named na
 | LocalRawAssum (nas, Default _, _) -> List.iter check_named nas
 | LocalRawAssum (nas, Generalized _, _) -> ()
+| LocalPattern _ -> assert false
 
 let interp_mutual_inductive (paramsl,indl) notations poly prv finite =
   check_all_names_different indl;
@@ -563,7 +579,7 @@ let interp_mutual_inductive (paramsl,indl) notations poly prv finite =
       
   (* Names of parameters as arguments of the inductive type (defs removed) *)
   let assums = List.filter is_local_assum ctx_params in
-  let params = List.map (fun decl -> out_name (get_name decl)) assums in
+  let params = List.map (RelDecl.get_name %> out_name) assums in
 
   (* Interpret the arities *)
   let arities = List.map (interp_ind_arity env_params evdref) indl in
@@ -630,7 +646,8 @@ let interp_mutual_inductive (paramsl,indl) notations poly prv finite =
     mind_entry_inds = entries;
     mind_entry_polymorphic = poly;
     mind_entry_private = if prv then Some false else None;
-    mind_entry_universes = uctx },
+    mind_entry_universes = uctx;
+  },
     pl, impls
 
 (* Very syntactical equality *)
@@ -724,8 +741,10 @@ let do_mutual_inductive indl poly prv finite =
   (* Declare the possible notations of inductive types *)
   List.iter Metasyntax.add_notation_interpretation ntns;
   (* Declare the coercions *)
-  List.iter (fun qid -> Class.try_add_new_coercion (locate qid) false poly) coes
-	    
+  List.iter (fun qid -> Class.try_add_new_coercion (locate qid) false poly) coes;
+  (* If positivity is assumed declares itself as unsafe. *)
+  if Environ.deactivated_guard (Global.env ()) then Feedback.feedback Feedback.AddedAxiom else ()
+
 (* 3c| Fixpoints and co-fixpoints *)
 
 (* An (unoptimized) function that maps preorders to partial orders...
@@ -776,20 +795,25 @@ let rec partial_order cmp = function
 let non_full_mutual_message x xge y yge isfix rest =
   let reason =
     if Id.List.mem x yge then
-      pr_id y ++ str " depends on " ++ pr_id x ++ str " but not conversely"
+      pr_id y ++ str " depends on " ++ pr_id x ++ strbrk " but not conversely"
     else if Id.List.mem y xge then
-      pr_id x ++ str " depends on " ++ pr_id y ++ str " but not conversely"
+      pr_id x ++ str " depends on " ++ pr_id y ++ strbrk " but not conversely"
     else
-      pr_id y ++ str " and " ++ pr_id x ++ str " are not mutually dependent" in
-  let e = if List.is_empty rest then reason else str "e.g., " ++ reason in
+      pr_id y ++ str " and " ++ pr_id x ++ strbrk " are not mutually dependent" in
+  let e = if List.is_empty rest then reason else strbrk "e.g., " ++ reason in
   let k = if isfix then "fixpoint" else "cofixpoint" in
   let w =
     if isfix
-    then str "Well-foundedness check may fail unexpectedly." ++ fnl()
+    then strbrk "Well-foundedness check may fail unexpectedly." ++ fnl()
     else mt () in
-  str "Not a fully mutually defined " ++ str k ++ fnl () ++
+  strbrk "Not a fully mutually defined " ++ str k ++ fnl () ++
   str "(" ++ e ++ str ")." ++ fnl () ++ w
 
+let warn_non_full_mutual =
+  CWarnings.create ~name:"non-full-mutual" ~category:"fixpoints"
+         (fun (x,xge,y,yge,isfix,rest) ->
+          non_full_mutual_message x xge y yge isfix rest)
+
 let check_mutuality env isfix fixl =
   let names = List.map fst fixl in
   let preorder =
@@ -799,7 +823,7 @@ let check_mutuality env isfix fixl =
   let po = partial_order Id.equal preorder in
   match List.filter (function (_,Inr _) -> true | _ -> false) po with
     | (x,Inr xge)::(y,Inr yge)::rest ->
-	Feedback.msg_warning (non_full_mutual_message x xge y yge isfix rest)
+       warn_non_full_mutual (x,xge,y,yge,isfix,rest)
     | _ -> ()
 
 type structured_fixpoint_expr = {
@@ -834,7 +858,7 @@ let declare_fix ?(opaque = false) (_,poly,_ as kind) pl ctx f ((def,_),eff) t im
   declare_definition f kind ce pl imps (Lemmas.mk_hook (fun _ r -> r))
 
 let _ = Obligations.declare_fix_ref :=
-	  (fun ?opaque k ctx f d t imps -> declare_fix ?opaque k [] ctx f d t imps)
+  (fun ?opaque k ctx f d t imps -> declare_fix ?opaque k [] ctx f d t imps)
 
 let prepare_recursive_declaration fixnames fixtypes fixdefs =
   let defs = List.map (subst_vars (List.rev fixnames)) fixdefs in
@@ -888,8 +912,8 @@ let rec telescope = function
       let ty, tys, (k, constr) =
 	List.fold_left
 	  (fun (ty, tys, (k, constr)) decl ->
-            let t = get_type decl in
-            let pred = mkLambda (get_name decl, t, ty) in
+            let t = RelDecl.get_type decl in
+            let pred = mkLambda (RelDecl.get_name decl, t, ty) in
 	    let ty = Universes.constr_of_global (Lazy.force sigT).typ in
 	    let intro = Universes.constr_of_global (Lazy.force sigT).intro in
 	    let sigty = mkApp (ty, [|t; pred|]) in
@@ -899,7 +923,7 @@ let rec telescope = function
       in
       let (last, subst) = List.fold_right2
         (fun pred decl (prev, subst) ->
-          let t = get_type decl in
+          let t = RelDecl.get_type decl in
 	  let p1 = Universes.constr_of_global (Lazy.force sigT).proj1 in
 	  let p2 = Universes.constr_of_global (Lazy.force sigT).proj2 in
 	  let proj1 = applistc p1 [t; pred; prev] in
@@ -930,13 +954,12 @@ let build_wellfounded (recname,pl,n,bl,arityc,body) poly r measure notation =
   let binders = letbinders @ [arg] in
   let binders_env = push_rel_context binders_rel env in
   let rel, _ = interp_constr_evars_impls env evdref r in
-  let () = check_evars_are_solved env !evdref (Evd.empty,!evdref)  in
   let relty = Typing.unsafe_type_of env !evdref rel in
   let relargty =
     let error () =
-      user_err_loc (constr_loc r,
-		    "Command.build_wellfounded",
-		    Printer.pr_constr_env env !evdref rel ++ str " is not an homogeneous binary relation.")
+      user_err ~loc:(constr_loc r)
+               ~hdr:"Command.build_wellfounded"
+		    (Printer.pr_constr_env env !evdref rel ++ str " is not an homogeneous binary relation.")
     in
       try
 	let ctx, ar = Reductionops.splay_prod_n env !evdref 2 relty in
@@ -944,7 +967,7 @@ let build_wellfounded (recname,pl,n,bl,arityc,body) poly r measure notation =
 	  | [LocalAssum (_,t); LocalAssum (_,u)], Sort (Prop Null)
 	      when Reductionops.is_conv env !evdref t u -> t
 	  | _, _ -> error ()
-      with e when Errors.noncritical e -> error ()
+      with e when CErrors.noncritical e -> error ()
   in
   let measure = interp_casted_constr_evars binders_env evdref measure relargty in
   let wf_rel, wf_rel_fun, measure_fn =
@@ -1067,7 +1090,7 @@ let interp_recursive isfix fixl notations =
         | Some ls , Some us ->
 	   if not (CList.for_all2eq (fun x y -> Id.equal (snd x) (snd y)) ls us) then
 	     error "(co)-recursive definitions should all have the same universe binders";
-	   Some (ls @ us)) fixl None in
+	   Some us) fixl None in
   let ctx = Evd.make_evar_universe_context env all_universes in
   let evdref = ref (Evd.from_ctx ctx) in
   let fixctxs, fiximppairs, fixannots =
@@ -1088,7 +1111,7 @@ let interp_recursive isfix fixl notations =
 	     try 
 	       let app = mkApp (delayed_force fix_proto, [|sort; t|]) in
 		 Typing.e_solve_evars env evdref app
-	     with e  when Errors.noncritical e -> t
+	     with e  when CErrors.noncritical e -> t
 	   in
 	     LocalAssum (id,fixprot) :: env'
 	 else LocalAssum (id,t) :: env')
@@ -1109,11 +1132,11 @@ let interp_recursive isfix fixl notations =
       () in
 
   (* Instantiate evars and check all are resolved *)
-  let evd = consider_remaining_unif_problems env_rec !evdref in
+  let evd = solve_unif_constraints_with_heuristics env_rec !evdref in
   let evd, nf = nf_evars_and_universes evd in
   let fixdefs = List.map (Option.map nf) fixdefs in
   let fixtypes = List.map nf fixtypes in
-  let fixctxnames = List.map (fun (_,ctx) -> List.map get_name ctx) fixctxs in
+  let fixctxnames = List.map (fun (_,ctx) -> List.map RelDecl.get_name ctx) fixctxs in
 
   (* Build the fix declaration block *)
   (env,rec_sign,all_universes,evd), (fixnames,fixdefs,fixtypes), List.combine3 fixctxnames fiximps fixannots
@@ -1231,6 +1254,11 @@ let out_def = function
   | Some def -> def
   | None -> error "Program Fixpoint needs defined bodies."
 
+let collect_evars_of_term evd c ty =
+  let evars = Evar.Set.union (Evd.evars_of_term c) (Evd.evars_of_term ty) in
+  Evar.Set.fold (fun ev acc -> Evd.add acc ev (Evd.find_undefined evd ev))
+  evars (Evd.from_ctx (Evd.evar_universe_context evd))
+
 let do_program_recursive local p fixkind fixl ntns =
   let isfix = fixkind != Obligations.IsCoFixpoint in
   let (env, rec_sign, pl, evd), fix, info = 
@@ -1248,8 +1276,9 @@ let do_program_recursive local p fixkind fixl ntns =
     and typ =
       nf_evar evd (Termops.it_mkNamedProd_or_LetIn typ rec_sign)
     in
+    let evm = collect_evars_of_term evd def typ in
     let evars, _, def, typ = 
-      Obligations.eterm_obligations env id evd
+      Obligations.eterm_obligations env id evm
 	(List.length rec_sign) def typ
     in (id, def, typ, imps, evars)
   in
@@ -1264,8 +1293,12 @@ let do_program_recursive local p fixkind fixl ntns =
 	Array.of_list (List.map (subst_vars (List.rev fixnames)) fixdefs)
       in
       let indexes = 
-	Pretyping.search_guard Loc.ghost (Global.env ()) possible_indexes fixdecls in
-	List.iteri (fun i _ -> Inductive.check_fix env ((indexes,i),fixdecls)) fixl
+        Pretyping.search_guard
+          Loc.ghost (Global.env ()) possible_indexes fixdecls in
+      List.iteri (fun i _ ->
+          Inductive.check_fix env
+                              ((indexes,i),fixdecls))
+        fixl
   end in
   let ctx = Evd.evar_universe_context evd in
   let kind = match fixkind with
@@ -1282,7 +1315,7 @@ let do_program_fixpoint local poly l =
 	  match n with
 	  | Some n -> mkIdentC (snd n)
 	  | None ->
-	      errorlabstrm "do_program_fixpoint"
+	      user_err ~hdr:"do_program_fixpoint"
 		(str "Recursive argument required for well-founded fixpoints")
 	in build_wellfounded (id, pl, n, bl, typ, out_def def) poly r recarg ntn
 	     
@@ -1296,9 +1329,14 @@ let do_program_fixpoint local poly l =
 	  do_program_recursive local poly fixkind fixl ntns
 
     | _, _ ->
-	errorlabstrm "do_program_fixpoint"
+	user_err ~hdr:"do_program_fixpoint"
 	  (str "Well-founded fixpoints not allowed in mutually recursive blocks")
 
+let check_safe () =
+  let open Declarations in
+  let flags = Environ.typing_flags (Global.env ()) in
+  flags.check_universes && flags.check_guarded
+
 let do_fixpoint local poly l =
   if Flags.is_program_mode () then do_program_fixpoint local poly l
   else
@@ -1306,7 +1344,8 @@ let do_fixpoint local poly l =
     let (_, _, _, info as fix) = interp_fixpoint fixl ntns in
     let possible_indexes =
       List.map compute_possible_guardness_evidences info in
-    declare_fixpoint local poly fix possible_indexes ntns
+    declare_fixpoint local poly fix possible_indexes ntns;
+    if not (check_safe ()) then Feedback.feedback Feedback.AddedAxiom else ()
 
 let do_cofixpoint local poly l =
   let fixl,ntns = extract_cofixpoint_components l in
@@ -1314,4 +1353,5 @@ let do_cofixpoint local poly l =
       do_program_recursive local poly Obligations.IsCoFixpoint fixl ntns
     else
       let cofix = interp_cofixpoint fixl ntns in
-	declare_cofixpoint local poly cofix ntns
+      declare_cofixpoint local poly cofix ntns;
+      if not (check_safe ()) then Feedback.feedback Feedback.AddedAxiom else ()
diff --git a/toplevel/command.mli b/vernac/command.mli
index b97cb487d..616afb91f 100644
--- a/toplevel/command.mli
+++ b/vernac/command.mli
@@ -22,7 +22,7 @@ open Pfedit
 
 val do_universe : polymorphic -> Id.t Loc.located list -> unit
 val do_constraint : polymorphic ->
-  (Id.t Loc.located * Univ.constraint_type * Id.t Loc.located) list -> unit
+  (Misctypes.glob_level * Univ.constraint_type * Misctypes.glob_level) list -> unit
 
 (** {6 Hooks for Pcoq} *)
 
@@ -161,9 +161,11 @@ val declare_cofixpoint : locality -> polymorphic ->
 (** Entry points for the vernacular commands Fixpoint and CoFixpoint *)
 
 val do_fixpoint :
+  (* When [false], assume guarded. *)
   locality -> polymorphic -> (fixpoint_expr * decl_notation list) list -> unit
 
 val do_cofixpoint :
+  (* When [false], assume guarded. *)
   locality -> polymorphic -> (cofixpoint_expr * decl_notation list) list -> unit
 
 (** Utils *)
diff --git a/toplevel/discharge.ml b/vernac/discharge.ml
index 6b267283a..e24d5e74f 100644
--- a/toplevel/discharge.ml
+++ b/vernac/discharge.ml
@@ -7,7 +7,7 @@
 (************************************************************************)
 
 open Names
-open Errors
+open CErrors
 open Util
 open Term
 open Vars
@@ -116,5 +116,5 @@ let process_inductive (sechyps,abs_ctx) modlist mib =
     mind_entry_inds = inds';
     mind_entry_polymorphic = mib.mind_polymorphic;
     mind_entry_private = mib.mind_private;
-    mind_entry_universes = univs
+    mind_entry_universes = univs;
   }
diff --git a/toplevel/discharge.mli b/vernac/discharge.mli
index 18d1b6776..18d1b6776 100644
--- a/toplevel/discharge.mli
+++ b/vernac/discharge.mli
diff --git a/toplevel/doc.tex b/vernac/doc.tex
index f2550fda1..f2550fda1 100644
--- a/toplevel/doc.tex
+++ b/vernac/doc.tex
diff --git a/toplevel/cerrors.ml b/vernac/explainErr.ml
index 0bb7966d7..17897460c 100644
--- a/toplevel/cerrors.ml
+++ b/vernac/explainErr.ml
@@ -7,19 +7,12 @@
 (************************************************************************)
 
 open Pp
-open Errors
+open CErrors
 open Indtypes
 open Type_errors
 open Pretype_errors
 open Indrec
 
-let print_loc loc =
-  if Loc.is_ghost loc then
-    (str"<unknown>")
-  else
-    let loc = Loc.unloc loc in
-    (int (fst loc) ++ str"-" ++ int (snd loc))
-
 let guill s = str "\"" ++ str s ++ str "\""
 
 (** Invariant : exceptions embedded in EvaluatedError satisfy
@@ -43,11 +36,11 @@ let explain_exn_default = function
   | Sys.Break -> hov 0 (fnl () ++ str "User interrupt.")
   (* Exceptions with pre-evaluated error messages *)
   | EvaluatedError (msg,None) -> msg
-  | EvaluatedError (msg,Some reraise) -> msg ++ Errors.print reraise
+  | EvaluatedError (msg,Some reraise) -> msg ++ CErrors.print reraise
   (* Otherwise, not handled here *)
-  | _ -> raise Errors.Unhandled
+  | _ -> raise CErrors.Unhandled
 
-let _ = Errors.register_handler explain_exn_default
+let _ = CErrors.register_handler explain_exn_default
 
 
 (** Pre-explain a vernac interpretation error *)
@@ -119,10 +112,10 @@ let process_vernac_interp_error ?(allow_uncaught=true) ?(with_header=true) (exc,
   let exc = strip_wrapping_exceptions exc in
   let e = process_vernac_interp_error with_header (exc, info) in
   let () =
-    if not allow_uncaught && not (Errors.handled (fst e)) then
+    if not allow_uncaught && not (CErrors.handled (fst e)) then
       let (e, info) = e in
       let msg = str "Uncaught exception " ++ str (Printexc.to_string e) in
-      let err = Errors.make_anomaly msg in
+      let err = CErrors.make_anomaly msg in
       Util.iraise (err, info)
   in
   let e' =
diff --git a/toplevel/cerrors.mli b/vernac/explainErr.mli
index a0e3e3c19..a67c887af 100644
--- a/toplevel/cerrors.mli
+++ b/vernac/explainErr.mli
@@ -6,9 +6,8 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(** Error report. *)
-
-val print_loc : Loc.t -> Pp.std_ppcmds
+(** Toplevel Exception *)
+exception EvaluatedError of Pp.std_ppcmds * exn option
 
 (** Pre-explain a vernac interpretation error *)
 
diff --git a/toplevel/himsg.ml b/vernac/himsg.ml
index ad848ccfc..6cff805fc 100644
--- a/toplevel/himsg.ml
+++ b/vernac/himsg.ml
@@ -25,6 +25,8 @@ open Printer
 open Evd
 open Context.Rel.Declaration
 
+module RelDecl = Context.Rel.Declaration
+
 (* This simplifies the typing context of Cases clauses *)
 (* hope it does not disturb other typing contexts *)
 let contract env lc =
@@ -35,13 +37,10 @@ let contract env lc =
           l := (Vars.substl !l c') :: !l;
           env
       | _ ->
-          let t' = Vars.substl !l (get_type decl) in
-          let c' = Option.map (Vars.substl !l) (get_value decl) in
-          let na' = named_hd env t' (get_name decl) in
+          let t = Vars.substl !l (RelDecl.get_type decl) in
+          let decl = decl |> RelDecl.map_name (named_hd env t) |> RelDecl.map_value (Vars.substl !l) |> RelDecl.set_type t in
           l := (mkRel 1) :: List.map (Vars.lift 1) !l;
-          match c' with
-          | None -> push_rel (LocalAssum (na',t')) env
-          | Some c' -> push_rel (LocalDef (na',c',t')) env
+          push_rel decl env
   in
   let env = process_rel_context contract_context env in
   (env, List.map (Vars.substl !l) lc)
@@ -69,12 +68,12 @@ let rec contract3' env a b c = function
       let (env',t1,t2) = contract2 env' t1 t2 in
       contract3 env a b c, ConversionFailed (env',t1,t2)
   | NotSameArgSize | NotSameHead | NoCanonicalStructure
-  | MetaOccurInBody _ | InstanceNotSameType _
+  | MetaOccurInBody _ | InstanceNotSameType _ | ProblemBeyondCapabilities
   | UnifUnivInconsistency _ as x -> contract3 env a b c, x
-  | CannotSolveConstraint ((pb,env,t,u),x) ->
-      let env,t,u = contract2 env t u in
+  | CannotSolveConstraint ((pb,env',t,u),x) ->
+      let env',t,u = contract2 env' t u in
       let y,x = contract3' env a b c x in
-      y,CannotSolveConstraint ((pb,env,t,u),x)
+      y,CannotSolveConstraint ((pb,env',t,u),x)
 
 (** Ad-hoc reductions *)
 
@@ -149,7 +148,7 @@ let pr_explicit env sigma t1 t2 = pr_explicit_aux env sigma t1 t2 explicit_flags
 
 let pr_db env i =
   try
-    match lookup_rel i env |> get_name with
+    match env |> lookup_rel i |> get_name with
       | Name id -> pr_id id
       | Anonymous -> str "<>"
   with Not_found -> str "UNBOUND_REL_" ++ int i
@@ -304,7 +303,8 @@ let explain_unification_error env sigma p1 p2 = function
         else []
      | MetaOccurInBody evk ->
         [str "instance for " ++ quote (pr_existential_key sigma evk) ++
-	strbrk " refers to a metavariable - please report your example"]
+	strbrk " refers to a metavariable - please report your example" ++
+        strbrk "at " ++ str Coq_config.wwwbugtracker ++ str "."]
      | InstanceNotSameType (evk,env,t,u) ->
         let t, u = pr_explicit env sigma t u in
         [str "unable to find a well-typed instantiation for " ++
@@ -320,9 +320,12 @@ let explain_unification_error env sigma p1 p2 = function
      | CannotSolveConstraint ((pb,env,t,u),e) ->
         let t = Evarutil.nf_evar sigma t in
         let u = Evarutil.nf_evar sigma u in
+        let env = make_all_name_different env in
         (strbrk "cannot satisfy constraint " ++ pr_lconstr_env env sigma t ++
         str " == " ++ pr_lconstr_env env sigma u)
         :: aux t u e
+     | ProblemBeyondCapabilities ->
+        []
      in
      match aux p1 p2 e with
      | [] -> mt ()
@@ -494,7 +497,7 @@ let explain_ill_formed_rec_body env sigma err names i fixenv vdefj =
       let fixenv = make_all_name_different fixenv in
       let pvd = pr_lconstr_env fixenv sigma vdefj.(i).uj_val in
 	str"Recursive definition is:" ++ spc () ++ pvd ++ str "."
-    with e when Errors.noncritical e -> mt ())
+    with e when CErrors.noncritical e -> mt ())
 
 let explain_ill_typed_rec_body env sigma i names vdefj vargs =
   let vdefj = Evarutil.jv_nf_evar sigma vdefj in
@@ -512,7 +515,8 @@ let explain_cant_find_case_type env sigma c =
   let c = Evarutil.nf_evar sigma c in
   let env = make_all_name_different env in
   let pe = pr_lconstr_env env sigma c in
-  str "Cannot infer type of pattern-matching on" ++ ws 1 ++ pe ++ str "."
+  str "Cannot infer the return type of pattern-matching on" ++ ws 1 ++
+    pe ++ str "."
 
 let explain_occur_check env sigma ev rhs =
   let rhs = Evarutil.nf_evar sigma rhs in
@@ -528,6 +532,8 @@ let pr_trailing_ne_context_of env sigma =
   else (str " in environment:"++ pr_context_unlimited env sigma)
 
 let rec explain_evar_kind env sigma evk ty = function
+  | Evar_kinds.NamedHole id ->
+      strbrk "the existential variable named " ++ pr_id id
   | Evar_kinds.QuestionMark _ ->
       strbrk "this placeholder of type " ++ ty
   | Evar_kinds.CasesType false ->
@@ -751,7 +757,7 @@ let pr_constraints printenv env sigma evars cstrs =
       let evs =
         prlist
         (fun (ev, evi) -> fnl () ++ pr_existential_key sigma ev ++
-            str " : " ++ pr_lconstr_env env' sigma evi.evar_concl) l
+            str " : " ++ pr_lconstr_env env' sigma evi.evar_concl ++ fnl ()) l
       in
       h 0 (pe ++ evs ++ pr_evar_constraints cstrs)
     else
@@ -1145,6 +1151,11 @@ let error_not_allowed_case_analysis isrec kind i =
   strbrk " is not allowed for inductive definition " ++
   pr_inductive (Global.env()) (fst i) ++ str "."
 
+let error_not_allowed_dependent_analysis isrec i =
+  str "Dependent " ++ str (if isrec then "Induction" else "Case analysis") ++
+  strbrk " is not allowed for inductive definition " ++
+  pr_inductive (Global.env()) i ++ str "."
+
 let error_not_mutual_in_scheme ind ind' =
   if eq_ind ind ind' then
     str "The inductive type " ++ pr_inductive (Global.env()) ind ++
@@ -1176,6 +1187,8 @@ let explain_recursion_scheme_error = function
   | NotAllowedCaseAnalysis (isrec,k,i) ->
       error_not_allowed_case_analysis isrec k i
   | NotMutualInScheme (ind,ind')-> error_not_mutual_in_scheme ind ind'
+  | NotAllowedDependentAnalysis (isrec, i) ->
+     error_not_allowed_dependent_analysis isrec i
 
 (* Pattern-matching errors *)
 
diff --git a/toplevel/himsg.mli b/vernac/himsg.mli
index ced54fd27..ced54fd27 100644
--- a/toplevel/himsg.mli
+++ b/vernac/himsg.mli
diff --git a/toplevel/ind_tables.ml b/vernac/ind_tables.ml
index 35717ed61..85d0b6194 100644
--- a/toplevel/ind_tables.ml
+++ b/vernac/ind_tables.ml
@@ -18,7 +18,7 @@ open Libobject
 open Nameops
 open Declarations
 open Term
-open Errors
+open CErrors
 open Util
 open Declare
 open Entries
@@ -87,7 +87,7 @@ let declare_scheme_object s aux f =
   try
     let _ = Hashtbl.find scheme_object_table key in
 (*    let aux_msg = if aux="" then "" else " (with key "^aux^")" in*)
-    errorlabstrm "IndTables.declare_scheme_object"
+    user_err ~hdr:"IndTables.declare_scheme_object"
       (str "Scheme object " ++ str key ++ str " already declared.")
   with Not_found ->
     Hashtbl.add scheme_object_table key (s,f);
diff --git a/toplevel/ind_tables.mli b/vernac/ind_tables.mli
index 20f30d6d1..20f30d6d1 100644
--- a/toplevel/ind_tables.mli
+++ b/vernac/ind_tables.mli
diff --git a/toplevel/indschemes.ml b/vernac/indschemes.ml
index f995a390c..f7e3f0d95 100644
--- a/toplevel/indschemes.ml
+++ b/vernac/indschemes.ml
@@ -15,7 +15,7 @@
    declaring new schemes *)
 
 open Pp
-open Errors
+open CErrors
 open Util
 open Names
 open Declarations
@@ -150,18 +150,18 @@ let alarm what internal msg =
   | UserAutomaticRequest
   | InternalTacticRequest ->
     (if debug then
-      Feedback.msg_warning
+      Feedback.msg_debug
 	(hov 0 msg ++ fnl () ++ what ++ str " not defined.")); None
   | _ -> Some msg
 
 let try_declare_scheme what f internal names kn =
   try f internal names kn
   with e ->
-  let e = Errors.push e in
+  let e = CErrors.push e in
   let msg = match fst e with
     | ParameterWithoutEquality cst ->
 	alarm what internal
-	  (str "Boolean equality not found for parameter " ++ pr_con cst ++
+	  (str "Boolean equality not found for parameter " ++ Printer.pr_global cst ++
 	   str".")
     | InductiveWithProduct ->
 	alarm what internal
@@ -186,14 +186,20 @@ let try_declare_scheme what f internal names kn =
     | DecidabilityMutualNotSupported ->
         alarm what internal
           (str "Decidability lemma for mutual inductive types not supported.")
-    | e when Errors.noncritical e ->
+    | EqUnknown s ->
+         alarm what internal
+           (str "Found unsupported " ++ str s ++ str " while building Boolean equality.")
+    | NoDecidabilityCoInductive ->
+         alarm what internal
+           (str "Scheme Equality is only for inductive types.")
+    | e when CErrors.noncritical e ->
         alarm what internal
-	  (str "Unexpected error during scheme creation: " ++ Errors.print e)
+	  (str "Unexpected error during scheme creation: " ++ CErrors.print e)
     | _ -> iraise e
   in
   match msg with
   | None -> ()
-  | Some msg -> iraise (UserError ("", msg), snd e)
+  | Some msg -> iraise (UserError (None, msg), snd e)
 
 let beq_scheme_msg mind =
   let mib = Global.lookup_mind mind in
@@ -217,7 +223,11 @@ let declare_beq_scheme = declare_beq_scheme_with []
 let declare_one_case_analysis_scheme ind =
   let (mib,mip) = Global.lookup_inductive ind in
   let kind = inductive_sort_family mip in
-  let dep = if kind == InProp then case_scheme_kind_from_prop else case_dep_scheme_kind_from_type in
+  let dep =
+    if kind == InProp then case_scheme_kind_from_prop
+    else if not (Inductiveops.has_dependent_elim mib) then
+      case_scheme_kind_from_type
+    else case_dep_scheme_kind_from_type in
   let kelim = elim_sorts (mib,mip) in
     (* in case the inductive has a type elimination, generates only one
        induction scheme, the other ones share the same code with the
@@ -237,15 +247,23 @@ let kinds_from_type =
    InProp,ind_dep_scheme_kind_from_type;
    InSet,rec_dep_scheme_kind_from_type]
 
+let nondep_kinds_from_type =
+  [InType,rect_scheme_kind_from_type;
+   InProp,ind_scheme_kind_from_type;
+   InSet,rec_scheme_kind_from_type]
+
 let declare_one_induction_scheme ind =
   let (mib,mip) = Global.lookup_inductive ind in
   let kind = inductive_sort_family mip in
   let from_prop = kind == InProp in
+  let depelim = Inductiveops.has_dependent_elim mib in
   let kelim = elim_sorts (mib,mip) in
   let elims =
     List.map_filter (fun (sort,kind) ->
       if Sorts.List.mem sort kelim then Some kind else None)
-      (if from_prop then kinds_from_prop else kinds_from_type) in
+      (if from_prop then kinds_from_prop
+       else if depelim then kinds_from_type
+       else nondep_kinds_from_type) in
   List.iter (fun kind -> ignore (define_individual_scheme kind UserAutomaticRequest None ind))
     elims
 
@@ -278,7 +296,7 @@ let try_declare_eq_decidability kn =
 let declare_eq_decidability = declare_eq_decidability_scheme_with []
 
 let ignore_error f x =
-  try ignore (f x) with e when Errors.noncritical e -> ()
+  try ignore (f x) with e when CErrors.noncritical e -> ()
 
 let declare_rewriting_schemes ind =
   if Hipattern.is_inductive_equality ind then begin
@@ -295,15 +313,20 @@ let declare_rewriting_schemes ind =
       (define_individual_scheme rew_l2r_forward_dep_scheme_kind UserAutomaticRequest None) ind
   end
 
+let warn_cannot_build_congruence =
+  CWarnings.create ~name:"cannot-build-congruence" ~category:"schemes"
+         (fun () ->
+          strbrk "Cannot build congruence scheme because eq is not found")
+
 let declare_congr_scheme ind =
   if Hipattern.is_equality_type (mkInd ind) then begin
     if
       try Coqlib.check_required_library Coqlib.logic_module_name; true
-      with e when Errors.noncritical e -> false
+      with e when CErrors.noncritical e -> false
     then
       ignore (define_individual_scheme congr_scheme_kind UserAutomaticRequest None ind)
     else
-      Feedback.msg_warning (strbrk "Cannot build congruence scheme because eq is not found")
+      warn_cannot_build_congruence ()
   end
 
 let declare_sym_scheme ind =
@@ -387,7 +410,6 @@ let do_mutual_induction_scheme lnamedepindsort =
   let sigma, listdecl = Indrec.build_mutual_induction_scheme env0 sigma lrecspec in
   let declare decl fi lrecref =
     let decltype = Retyping.get_type_of env0 sigma decl in
-    (* let decltype = refresh_universes decltype in *)
     let proof_output = Future.from_val ((decl,Univ.ContextSet.empty),Safe_typing.empty_private_constants) in
     let cst = define fi UserIndividualRequest sigma proof_output (Some decltype) in
     ConstRef cst :: lrecref
@@ -497,7 +519,8 @@ let map_inductive_block f kn n = for i=0 to n-1 do f (kn,i) done
 let declare_default_schemes kn =
   let mib = Global.lookup_mind kn in
   let n = Array.length mib.mind_packets in
-  if !elim_flag && (mib.mind_finite <> BiFinite || !bifinite_elim_flag) then
+  if !elim_flag && (mib.mind_finite <> BiFinite || !bifinite_elim_flag)
+     && mib.mind_typing_flags.check_guarded then
     declare_induction_schemes kn;
   if !case_flag then map_inductive_block declare_one_case_analysis_scheme kn n;
   if is_eq_flag() then try_declare_beq_scheme kn;
diff --git a/toplevel/indschemes.mli b/vernac/indschemes.mli
index e5d79fd51..e5d79fd51 100644
--- a/toplevel/indschemes.mli
+++ b/vernac/indschemes.mli
diff --git a/stm/lemmas.ml b/vernac/lemmas.ml
index 0a63a3a0f..55f33be39 100644
--- a/stm/lemmas.ml
+++ b/vernac/lemmas.ml
@@ -9,7 +9,7 @@
 (* Created by Hugo Herbelin from contents related to lemma proofs in
    file command.ml, Aug 2009 *)
 
-open Errors
+open CErrors
 open Util
 open Flags
 open Pp
@@ -33,20 +33,22 @@ open Constrintern
 open Impargs
 open Context.Rel.Declaration
 
+module RelDecl = Context.Rel.Declaration
+module NamedDecl = Context.Named.Declaration
+
 type 'a declaration_hook = Decl_kinds.locality -> Globnames.global_reference -> 'a
 let mk_hook hook = hook
 let call_hook fix_exn hook l c =
   try hook l c
-  with e when Errors.noncritical e ->
-    let e = Errors.push e in
+  with e when CErrors.noncritical e ->
+    let e = CErrors.push e in
     iraise (fix_exn e)
 
 (* Support for mutually proved theorems *)
 
 let retrieve_first_recthm = function
   | VarRef id ->
-      let open Context.Named.Declaration in
-      (get_value (Global.lookup_named id),variable_opacity id)
+      (NamedDecl.get_value (Global.lookup_named id),variable_opacity id)
   | ConstRef cst ->
       let cb = Global.lookup_constant cst in
       (Global.body_of_constant_body cb, is_opaque cb)
@@ -79,7 +81,7 @@ let adjust_guardness_conditions const = function
                     List.fold_left (fun e (_,c,cb,_) -> add c cb e) env l)
                 env (Safe_typing.side_effects_of_private_constants eff) in
               let indexes =
-	        search_guard Loc.ghost env
+                search_guard Loc.ghost env
                   possible_indexes fixdecls in
 		(mkFix ((indexes,0),fixdecls), ctx), eff
           | _ -> (body, ctx), eff) }
@@ -106,11 +108,11 @@ let find_mutually_recursive_statements thms =
       (* Cofixpoint or fixpoint w/o explicit decreasing argument *)
       | None | Some (None, CStructRec) ->
       let whnf_hyp_hds = map_rel_context_in_env
-        (fun env c -> fst (whd_betadeltaiota_stack env Evd.empty c))
+        (fun env c -> fst (whd_all_stack env Evd.empty c))
         (Global.env()) hyps in
       let ind_hyps =
         List.flatten (List.map_i (fun i decl ->
-          let t = get_type decl in
+          let t = RelDecl.get_type decl in
           match kind_of_term t with
           | Ind ((kn,_ as ind),u) when
                 let mind = Global.lookup_mind kn in
@@ -120,7 +122,7 @@ let find_mutually_recursive_statements thms =
               []) 0 (List.rev whnf_hyp_hds)) in
       let ind_ccl =
         let cclenv = push_rel_context hyps (Global.env()) in
-        let whnf_ccl,_ = whd_betadeltaiota_stack cclenv Evd.empty ccl in
+        let whnf_ccl,_ = whd_all_stack cclenv Evd.empty ccl in
         match kind_of_term whnf_ccl with
         | Ind ((kn,_ as ind),u) when
               let mind = Global.lookup_mind kn in
@@ -210,8 +212,8 @@ let save ?export_seff id const cstrs pl do_guard (locality,poly,kind) hook =
     definition_message id;
     Option.iter (Universes.register_universe_binders r) pl;
     call_hook (fun exn -> exn) hook l r
-  with e when Errors.noncritical e ->
-    let e = Errors.push e in
+  with e when CErrors.noncritical e ->
+    let e = CErrors.push e in
     iraise (fix_exn e)
 
 let default_thm_id = Id.of_string "Unnamed_thm"
@@ -222,7 +224,7 @@ let compute_proof_name locality = function
       if Nametab.exists_cci (Lib.make_path id) || is_section_variable id ||
 	 locality == Global && Nametab.exists_cci (Lib.make_path_except_section id)
       then
-        user_err_loc (loc,"",pr_id id ++ str " already exists.");
+        user_err ~loc  (pr_id id ++ str " already exists.");
       id, pl
   | None ->
       next_global_ident_away default_thm_id (Pfedit.get_all_proof_names ()), None
@@ -252,10 +254,14 @@ let save_remaining_recthms (locality,p,kind) norm ctx body opaq i ((id,pl),(t_i,
   | Some body ->
       let body = norm body in
       let k = Kindops.logical_kind_of_goal_kind kind in
-      let body_i = match kind_of_term body with
+      let rec body_i t = match kind_of_term t with
         | Fix ((nv,0),decls) -> mkFix ((nv,i),decls)
         | CoFix (0,decls) -> mkCoFix (i,decls)
+        | LetIn(na,t1,ty,t2) -> mkLetIn (na,t1,ty, body_i t2)
+        | Lambda(na,ty,t) -> mkLambda(na,ty,body_i t)
+        | App (t, args) -> mkApp (body_i t, args)
         | _ -> anomaly Pp.(str "Not a proof by induction: " ++ Printer.pr_constr body) in
+      let body_i = body_i body in
       match locality with
       | Discharge ->
           let const = definition_entry ~types:t_i ~opaque:opaq ~poly:p 
@@ -301,13 +307,16 @@ let save_anonymous_with_strength ?export_seff proof kind save_ident =
 
 (* Admitted *)
 
+let warn_let_as_axiom =
+  CWarnings.create ~name:"let-as-axiom" ~category:"vernacular"
+                   (fun id -> strbrk "Let definition" ++ spc () ++ pr_id id ++
+                                spc () ++ strbrk "declared as an axiom.")
+
 let admit (id,k,e) pl hook () =
   let kn = declare_constant id (ParameterEntry e, IsAssumption Conjectural) in
   let () = match k with
   | Global, _, _ -> ()
-  | Local, _, _ | Discharge, _, _ ->
-    Feedback.msg_warning (str "Let definition" ++ spc () ++ pr_id id ++ spc () ++
-      str "declared as an axiom.")
+  | Local, _, _ | Discharge, _, _ -> warn_let_as_axiom id
   in
   let () = assumption_message id in
   Option.iter (Universes.register_universe_binders (ConstRef kn)) pl;
@@ -328,7 +337,7 @@ let get_proof proof do_guard hook opacity =
 let check_exist =
   List.iter (fun (loc,id) ->
     if not (Nametab.exists_cci (Lib.make_path id)) then
-        user_err_loc (loc,"",pr_id id ++ str " does not exist.")
+        user_err ~loc  (pr_id id ++ str " does not exist.")
   )
 
 let universe_proof_terminator compute_guard hook =
@@ -442,7 +451,7 @@ let start_proof_with_initialization kind ctx recguard thms snl hook =
 	  call_hook (fun exn -> exn) hook strength ref) thms_data in
       start_proof_univs id ?pl kind ctx t ?init_tac (fun ctx -> mk_hook (hook ctx)) ~compute_guard:guard
 
-let start_proof_com kind thms hook =
+let start_proof_com ?inference_hook kind thms hook =
   let env0 = Global.env () in
   let levels = Option.map snd (fst (List.hd thms)) in 
   let evdref = ref (match levels with
@@ -452,8 +461,10 @@ let start_proof_com kind thms hook =
   let thms = List.map (fun (sopt,(bl,t,guard)) ->
     let impls, ((env, ctx), imps) = interp_context_evars env0 evdref bl in
     let t', imps' = interp_type_evars_impls ~impls env evdref t in
-    evdref := solve_remaining_evars all_and_fail_flags env !evdref (Evd.empty,!evdref);
-    let ids = List.map get_name ctx in
+    let flags = all_and_fail_flags in
+    let flags = { flags with use_hook = inference_hook } in
+    evdref := solve_remaining_evars flags env !evdref (Evd.empty,!evdref);
+    let ids = List.map RelDecl.get_name ctx in
       (compute_proof_name (pi1 kind) sopt,
       (nf_evar !evdref (it_mkProd_or_LetIn t' ctx),
        (ids, imps @ lift_implicits (List.length ids) imps'),
@@ -462,6 +473,11 @@ let start_proof_com kind thms hook =
   let recguard,thms,snl = look_for_possibly_mutual_statements thms in
   let evd, nf = Evarutil.nf_evars_and_universes !evdref in
   let thms = List.map (fun (n, (t, info)) -> (n, (nf t, info))) thms in
+  let () =
+    match levels with
+    | None -> ()
+    | Some l -> ignore (Evd.universe_context evd ?names:l)
+  in
   let evd =
     if pi2 kind then evd
     else (* We fix the variables to ensure they won't be lowered to Set *)
@@ -472,6 +488,18 @@ let start_proof_com kind thms hook =
 
 (* Saving a proof *)
 
+let keep_admitted_vars = ref true
+
+let _ =
+  let open Goptions in
+  declare_bool_option
+    { optsync  = true;
+      optdepr  = false;
+      optname  = "keep section variables in admitted proofs";
+      optkey   = ["Keep"; "Admitted"; "Variables"];
+      optread  = (fun () -> !keep_admitted_vars);
+      optwrite = (fun b -> keep_admitted_vars := b) }
+
 let save_proof ?proof = function
   | Vernacexpr.Admitted ->
       let pe =
@@ -485,14 +513,18 @@ let save_proof ?proof = function
               error "Admitted requires an explicit statement";
             let typ = Option.get const_entry_type in
             let ctx = Evd.evar_context_universe_context (fst universes) in
-            Admitted(id, k, (const_entry_secctx, pi2 k, (typ, ctx), None), universes)
+            let sec_vars = if !keep_admitted_vars then const_entry_secctx else None in
+            Admitted(id, k, (sec_vars, pi2 k, (typ, ctx), None), universes)
         | None ->
+            let pftree = Pfedit.get_pftreestate () in
             let id, k, typ = Pfedit.current_proof_statement () in
+            let universes = Proof.initial_euctx pftree in
             (* This will warn if the proof is complete *)
-            let pproofs, universes =
+            let pproofs, _univs =
               Proof_global.return_proof ~allow_partial:true () in
             let sec_vars =
-              match  Pfedit.get_used_variables(), pproofs with
+              if not !keep_admitted_vars then None
+              else match  Pfedit.get_used_variables(), pproofs with
               | Some _ as x, _ -> x
               | None, (pproof, _) :: _ -> 
                   let env = Global.env () in
@@ -501,7 +533,8 @@ let save_proof ?proof = function
                   Some (Environ.keep_hyps env (Idset.union ids_typ ids_def))
               | _ -> None in
 	    let names = Pfedit.get_universe_binders () in
-            let binders, ctx = Evd.universe_context ?names (Evd.from_ctx universes) in
+            let evd = Evd.from_ctx universes in
+            let binders, ctx = Evd.universe_context ?names evd in
             Admitted(id,k,(sec_vars, pi2 k, (typ, ctx), None),
 		     (universes, Some binders))
       in
diff --git a/stm/lemmas.mli b/vernac/lemmas.mli
index f751598f0..39c089be9 100644
--- a/stm/lemmas.mli
+++ b/vernac/lemmas.mli
@@ -33,7 +33,9 @@ val start_proof_univs : Id.t -> ?pl:universe_binders -> goal_kind -> Evd.evar_ma
   ?init_tac:unit Proofview.tactic -> ?compute_guard:lemma_possible_guards -> 
   (Evd.evar_universe_context option -> unit declaration_hook) -> unit
 
-val start_proof_com : goal_kind -> Vernacexpr.proof_expr list ->
+val start_proof_com :
+  ?inference_hook:Pretyping.inference_hook ->
+  goal_kind -> Vernacexpr.proof_expr list ->
   unit declaration_hook -> unit
 
 val start_proof_with_initialization : 
diff --git a/toplevel/locality.ml b/vernac/locality.ml
index c4c891b89..03640676e 100644
--- a/toplevel/locality.ml
+++ b/vernac/locality.ml
@@ -18,7 +18,7 @@ let check_locality locality_flag =
   match locality_flag with
   | Some b ->
     let s = if b then "Local" else "Global" in
-    Errors.errorlabstrm "Locality.check_locality"
+    CErrors.user_err ~hdr:"Locality.check_locality"
       (str "This command does not support the \"" ++ str s ++ str "\" prefix.")
   | None -> ()
 
@@ -26,17 +26,22 @@ let check_locality locality_flag =
 
 (* Commands which supported an inlined Local flag *)
 
+let warn_deprecated_local_syntax =
+  CWarnings.create ~name:"deprecated-local-syntax" ~category:"deprecated"
+         (fun () ->
+          Pp.strbrk "Deprecated syntax: use \"Local\" as a prefix.")
+
 let enforce_locality_full locality_flag local =
   let local =
     match locality_flag with
     | Some false when local ->
-	Errors.error "Cannot be simultaneously Local and Global."
+	CErrors.error "Cannot be simultaneously Local and Global."
     | Some true when local ->
-	Errors.error "Use only prefix \"Local\"."
+	CErrors.error "Use only prefix \"Local\"."
     | None ->
 	if local then begin
-          Feedback.msg_warning (Pp.str "Obsolete syntax: use \"Local\" as a prefix.");
-	  Some true
+	    warn_deprecated_local_syntax ();
+	    Some true
 	end else
 	None
     | Some b -> Some b in
@@ -61,7 +66,7 @@ let enforce_locality_exp locality_flag local =
   | None, Some local -> local
   | Some b, None -> local_of_bool b
   | None, None -> Decl_kinds.Global
-  | Some _, Some _ -> Errors.error "Local non allowed in this case"
+  | Some _, Some _ -> CErrors.error "Local non allowed in this case"
 
 (* For commands whose default is to not discharge but to export:
    Global in sections forces discharge, Global not in section is the default;
@@ -82,7 +87,7 @@ let enforce_section_locality locality_flag local =
 let make_module_locality = function
   | Some false ->
       if Lib.sections_are_opened () then
-	Errors.error
+	CErrors.error
 	  "This command does not support the Global option in sections.";
       false
   | Some true -> true
diff --git a/toplevel/locality.mli b/vernac/locality.mli
index 2ec392eef..2ec392eef 100644
--- a/toplevel/locality.mli
+++ b/vernac/locality.mli
diff --git a/toplevel/metasyntax.ml b/vernac/metasyntax.ml
index 52117f13f..0aaf6afd7 100644
--- a/toplevel/metasyntax.ml
+++ b/vernac/metasyntax.ml
@@ -8,7 +8,7 @@
 
 open Pp
 open Flags
-open Errors
+open CErrors
 open Util
 open Names
 open Constrexpr
@@ -20,10 +20,8 @@ open Extend
 open Libobject
 open Constrintern
 open Vernacexpr
-open Pcoq
 open Libnames
 open Tok
-open Egramcoq
 open Notation
 open Nameops
 
@@ -46,12 +44,30 @@ let add_token_obj s = Lib.add_anonymous_leaf (inToken s)
 
 let entry_buf = Buffer.create 64
 
+type any_entry = AnyEntry : 'a Pcoq.Gram.entry -> any_entry
+
+let grammars : any_entry list String.Map.t ref = ref String.Map.empty
+
+let register_grammar name grams =
+  grammars := String.Map.add name grams !grammars
+
 let pr_entry e =
   let () = Buffer.clear entry_buf in
   let ft = Format.formatter_of_buffer entry_buf in
-  let () = Gram.entry_print ft e in
+  let () = Pcoq.Gram.entry_print ft e in
   str (Buffer.contents entry_buf)
 
+let pr_registered_grammar name =
+  let gram = try Some (String.Map.find name !grammars) with Not_found -> None in
+  match gram with
+  | None -> error "Unknown or unprintable grammar entry."
+  | Some entries ->
+    let pr_one (AnyEntry e) =
+      str "Entry " ++ str (Pcoq.Gram.Entry.name e) ++ str " is" ++ fnl () ++
+      pr_entry e
+    in
+    prlist pr_one entries
+
 let pr_grammar = function
   | "constr" | "operconstr" | "binder_constr" ->
       str "Entry constr is" ++ fnl () ++
@@ -64,15 +80,6 @@ let pr_grammar = function
       pr_entry Pcoq.Constr.operconstr
   | "pattern" ->
       pr_entry Pcoq.Constr.pattern
-  | "tactic" ->
-      str "Entry tactic_expr is" ++ fnl () ++
-      pr_entry Pcoq.Tactic.tactic_expr ++
-      str "Entry binder_tactic is" ++ fnl () ++
-      pr_entry Pcoq.Tactic.binder_tactic ++
-      str "Entry simple_tactic is" ++ fnl () ++
-      pr_entry Pcoq.Tactic.simple_tactic ++
-      str "Entry tactic_arg is" ++ fnl () ++
-      pr_entry Pcoq.Tactic.tactic_arg
   | "vernac" ->
       str "Entry vernac is" ++ fnl () ++
       pr_entry Pcoq.Vernac_.vernac ++
@@ -84,7 +91,7 @@ let pr_grammar = function
       pr_entry Pcoq.Vernac_.gallina ++
       str "Entry gallina_ext is" ++ fnl () ++
       pr_entry Pcoq.Vernac_.gallina_ext
-  | _ -> error "Unknown or unprintable grammar entry."
+  | name -> pr_registered_grammar name
 
 (**********************************************************************)
 (* Parse a format (every terminal starting with a letter or a single
@@ -184,7 +191,7 @@ let parse_format ((loc, str) : lstring) =
     else
       error "Empty format."
   with reraise ->
-    let (e, info) = Errors.push reraise in
+    let (e, info) = CErrors.push reraise in
     let info = Loc.add_loc info loc in
     iraise (e, info)
 
@@ -238,7 +245,7 @@ let rec find_pattern nt xl = function
   | _, Break s :: _ | Break s :: _, _ ->
       error ("A break occurs on one side of \"..\" but not on the other side.")
   | _, Terminal s :: _ | Terminal s :: _, _ ->
-      errorlabstrm "Metasyntax.find_pattern"
+      user_err ~hdr:"Metasyntax.find_pattern"
         (str "The token \"" ++ str s ++ str "\" occurs on one side of \"..\" but not on the other side.")
   | _, [] ->
       error msg_expected_form_of_recursive_notation
@@ -300,7 +307,7 @@ let rec get_notation_vars = function
       let vars = get_notation_vars sl in
       if Id.equal id ldots_var then vars else
 	if Id.List.mem id vars then
-	  errorlabstrm "Metasyntax.get_notation_vars"
+	  user_err ~hdr:"Metasyntax.get_notation_vars"
             (str "Variable " ++ pr_id id ++ str " occurs more than once.")
 	else
           id::vars
@@ -314,7 +321,7 @@ let analyze_notation_tokens l =
   recvars, List.subtract Id.equal vars (List.map snd recvars), l
 
 let error_not_same_scope x y =
-  errorlabstrm "Metasyntax.error_not_name_scope"
+  user_err ~hdr:"Metasyntax.error_not_name_scope"
     (str "Variables " ++ pr_id x ++ str " and " ++ pr_id y ++ str " must be in the same scope.")
 
 (**********************************************************************)
@@ -390,7 +397,7 @@ let check_open_binder isopen sl m =
   | _ -> assert false
   in
   if isopen && not (List.is_empty sl) then
-    errorlabstrm "" (str "as " ++ pr_id m ++
+    user_err  (str "as " ++ pr_id m ++
       str " is a non-closed binder, no such \"" ++
       prlist_with_sep spc pr_token sl
       ++ strbrk "\" is allowed to occur.")
@@ -661,7 +668,7 @@ let pr_level ntn (from,args) =
   prlist_with_sep pr_comma (pr_arg_level from) args
 
 let error_incompatible_level ntn oldprec prec =
-  errorlabstrm ""
+  user_err 
     (str "Notation " ++ str ntn ++ str " is already defined" ++ spc() ++
     pr_level ntn oldprec ++
     spc() ++ str "while it is now required to be" ++ spc() ++
@@ -673,24 +680,32 @@ type syntax_extension = {
   synext_notgram : notation_grammar;
   synext_unparsing : unparsing list;
   synext_extra : (string * string) list;
+  synext_compat : Flags.compat_version option;
 }
 
+let is_active_compat = function
+| None -> true
+| Some v -> 0 <= Flags.version_compare v !Flags.compat_version
+
 type syntax_extension_obj = locality_flag * syntax_extension list
 
 let cache_one_syntax_extension se =
   let ntn = se.synext_notation in
   let prec = se.synext_level in
+  let onlyprint = se.synext_notgram.notgram_onlyprinting in
   try
     let oldprec = Notation.level_of_notation ntn in
     if not (Notation.level_eq prec oldprec) then error_incompatible_level ntn oldprec prec
   with Not_found ->
-    (* Reserve the notation level *)
-    Notation.declare_notation_level ntn prec;
-    (* Declare the parsing rule *)
-    Egramcoq.extend_constr_grammar prec se.synext_notgram;
-    (* Declare the printing rule *)
-    Notation.declare_notation_printing_rule ntn
-      ~extra:se.synext_extra (se.synext_unparsing, fst prec)
+    if is_active_compat se.synext_compat then begin
+      (* Reserve the notation level *)
+      Notation.declare_notation_level ntn prec;
+      (* Declare the parsing rule *)
+      if not onlyprint then Egramcoq.extend_constr_grammar prec se.synext_notgram;
+      (* Declare the notation rule *)
+      Notation.declare_notation_rule ntn
+        ~extra:se.synext_extra (se.synext_unparsing, fst prec) se.synext_notgram
+    end
 
 let cache_syntax_extension (_, (_, sy)) =
   List.iter cache_one_syntax_extension sy
@@ -721,61 +736,103 @@ let inSyntaxExtension : syntax_extension_obj -> obj =
 
 (* Interpreting user-provided modifiers *)
 
-let interp_modifiers modl =
-  let onlyparsing = ref false in
-  let rec interp assoc level etyps format extra = function
-    | [] ->
-	(assoc,level,etyps,!onlyparsing,format,extra)
+(* XXX: We could move this to the parser itself *)
+module NotationMods = struct
+
+type notation_modifier = {
+  assoc         : gram_assoc option;
+  level         : int option;
+  etyps         : (Id.t * simple_constr_prod_entry_key) list;
+
+  (* common to syn_data below *)
+  only_parsing  : bool;
+  only_printing : bool;
+  compat        : compat_version option;
+  format        : string Loc.located option;
+  extra         : (string * string) list;
+}
+
+let default = {
+  assoc         = None;
+  level         = None;
+  etyps         = [];
+  only_parsing  = false;
+  only_printing = false;
+  compat        = None;
+  format        = None;
+  extra         = [];
+}
+
+end
+
+let interp_modifiers modl = let open NotationMods in
+  let rec interp acc = function
+    | [] -> acc
     | SetEntryType (s,typ) :: l ->
 	let id = Id.of_string s in
-	if Id.List.mem_assoc id etyps then
-	  errorlabstrm "Metasyntax.interp_modifiers"
+	if Id.List.mem_assoc id acc.etyps then
+	  user_err ~hdr:"Metasyntax.interp_modifiers"
             (str s ++ str " is already assigned to an entry or constr level.");
-	interp assoc level ((id,typ)::etyps) format extra l
+        interp { acc with etyps = (id,typ) :: acc.etyps; } l
     | SetItemLevel ([],n) :: l ->
-	interp assoc level etyps format extra l
+        interp acc l
     | SetItemLevel (s::idl,n) :: l ->
 	let id = Id.of_string s in
-	if Id.List.mem_assoc id etyps then
-	  errorlabstrm "Metasyntax.interp_modifiers"
+	if Id.List.mem_assoc id acc.etyps then
+	  user_err ~hdr:"Metasyntax.interp_modifiers"
             (str s ++ str " is already assigned to an entry or constr level.");
 	let typ = ETConstr (n,()) in
-	interp assoc level ((id,typ)::etyps) format extra (SetItemLevel (idl,n)::l)
+        interp { acc with etyps = (id,typ)::acc.etyps; } (SetItemLevel (idl,n)::l)
     | SetLevel n :: l ->
-	if not (Option.is_empty level) then error "A level is given more than once.";
-	interp assoc (Some n) etyps format extra l
+
+        interp { acc with level = Some n; } l
     | SetAssoc a :: l ->
-	if not (Option.is_empty assoc) then error"An associativity is given more than once.";
-	interp (Some a) level etyps format extra l
-    | SetOnlyParsing _ :: l ->
-	onlyparsing := true;
-	interp assoc level etyps format extra l
+	if not (Option.is_empty acc.assoc) then error "An associativity is given more than once.";
+        interp { acc with assoc = Some a; } l
+     | SetOnlyParsing :: l ->
+        interp { acc with only_parsing = true; } l
+    | SetOnlyPrinting :: l ->
+        interp { acc with only_printing = true; } l
+    | SetCompatVersion v :: l ->
+        interp { acc with compat = Some v; } l
     | SetFormat ("text",s) :: l ->
-	if not (Option.is_empty format) then error "A format is given more than once.";
-	interp assoc level etyps (Some s) extra l
+	if not (Option.is_empty acc.format) then error "A format is given more than once.";
+        interp { acc with format = Some s; } l
     | SetFormat (k,(_,s)) :: l ->
-	interp assoc level etyps format ((k,s) :: extra) l
-  in interp None None [] None [] modl
+        interp { acc with extra = (k,s)::acc.extra; } l
+  in interp default modl
 
 let check_infix_modifiers modifiers =
-  let (assoc,level,t,b,fmt,extra) = interp_modifiers modifiers in
+  let t = (interp_modifiers modifiers).NotationMods.etyps in
   if not (List.is_empty t) then
     error "Explicit entry level or type unexpected in infix notation."
 
 let check_useless_entry_types recvars mainvars etyps =
   let vars = let (l1,l2) = List.split recvars in l1@l2@mainvars in
   match List.filter (fun (x,etyp) -> not (List.mem x vars)) etyps with
-  | (x,_)::_ -> errorlabstrm "Metasyntax.check_useless_entry_types"
+  | (x,_)::_ -> user_err ~hdr:"Metasyntax.check_useless_entry_types"
                   (pr_id x ++ str " is unbound in the notation.")
   | _ -> ()
 
-let no_syntax_modifiers = function
-  | [] | [SetOnlyParsing _] -> true
-  | _ -> false
+let not_a_syntax_modifier = function
+| SetOnlyParsing -> true
+| SetOnlyPrinting -> true
+| SetCompatVersion _ -> true
+| _ -> false
 
-let is_only_parsing = function
-  | [SetOnlyParsing _] -> true
-  | _ -> false
+let no_syntax_modifiers mods = List.for_all not_a_syntax_modifier mods
+
+let is_only_parsing mods =
+  let test = function SetOnlyParsing -> true | _ -> false in
+  List.exists test mods
+
+let is_only_printing mods =
+  let test = function SetOnlyPrinting -> true | _ -> false in
+  List.exists test mods
+
+let get_compat_version mods =
+  let test = function SetCompatVersion v -> Some v | _ -> None in
+  try Some (List.find_map test mods) with Not_found -> None
 
 (* Compute precedences from modifiers (or find default ones) *)
 
@@ -801,7 +858,7 @@ let join_auxiliary_recursive_types recvars etyps =
     | None, Some ytyp -> (x,ytyp)::typs
     | Some xtyp, Some ytyp when Pervasives.(=) xtyp ytyp -> typs (* FIXME *)
     | Some xtyp, Some ytyp ->
-	errorlabstrm ""
+	user_err 
 	  (strbrk "In " ++ pr_id x ++ str " .. " ++ pr_id y ++
 	   strbrk ", both ends have incompatible types."))
     recvars etyps
@@ -827,7 +884,7 @@ let make_interpretation_type isrec isonlybinding = function
   | NtnInternTypeConstr | NtnInternTypeIdent ->
      if isonlybinding then NtnTypeOnlyBinder else NtnTypeConstr
   | NtnInternTypeBinder when isrec -> NtnTypeBinderList
-  | NtnInternTypeBinder -> error "Type not allowed in recursive notation."
+   | NtnInternTypeBinder -> error "Type binder is only for use in recursive notations for binders."
 
 let make_interpretation_vars recvars allvars =
   let eq_subscope (sc1, l1) (sc2, l2) =
@@ -852,16 +909,23 @@ let check_rule_productivity l =
   if (match l with SProdList _ :: _ -> true | _ -> false) then
     error "A recursive notation must start with at least one symbol."
 
-let is_not_printable onlyparse noninjective = function
+let warn_notation_bound_to_variable =
+  CWarnings.create ~name:"notation-bound-to-variable" ~category:"parsing"
+         (fun () ->
+          strbrk "This notation will not be used for printing as it is bound to a single variable.")
+
+let warn_non_reversible_notation =
+  CWarnings.create ~name:"non-reversible-notation" ~category:"parsing"
+         (fun () ->
+          strbrk "This notation will not be used for printing as it is not reversible.")
+
+let is_not_printable onlyparse nonreversible = function
 | NVar _ ->
-  let () = if not onlyparse then
-    Feedback.msg_warning (strbrk "This notation will not be used for printing as it is bound to a single variable.")
-  in
+  if not onlyparse then warn_notation_bound_to_variable ();
   true
 | _ ->
-  if not onlyparse && noninjective then
-    let () = Feedback.msg_warning (strbrk "This notation will not be used for printing as it is not reversible.") in
-    true
+   if not onlyparse && nonreversible then
+     (warn_non_reversible_notation (); true)
   else onlyparse
 
 let find_precedence lev etyps symbols =
@@ -886,7 +950,7 @@ let find_precedence lev etyps symbols =
 	| ETName | ETBigint | ETReference ->
             begin match lev with
             | None ->
-	      ([Feedback.msg_info,strbrk "Setting notation at level 0."],0)
+	      ([Feedback.msg_info ?loc:None ,strbrk "Setting notation at level 0."],0)
             | Some 0 ->
               ([],0)
             | _ ->
@@ -904,7 +968,7 @@ let find_precedence lev etyps symbols =
 	else [],Option.get lev)
   | Terminal _ when last_is_terminal () ->
       if Option.is_empty lev then
-	([Feedback.msg_info,strbrk "Setting notation at level 0."], 0)
+	([Feedback.msg_info ?loc:None ,strbrk "Setting notation at level 0."], 0)
       else [],Option.get lev
   | _ ->
       if Option.is_empty lev then error "Cannot determine the level.";
@@ -916,6 +980,10 @@ let check_curly_brackets_notation_exists () =
     error "Notations involving patterns of the form \"{ _ }\" are treated \n\
 specially and require that the notation \"{ _ }\" is already reserved."
 
+let warn_skip_spaces_curly =
+  CWarnings.create ~name:"skip-spaces-curly" ~category:"parsing"
+      (fun () ->strbrk "Skipping spaces inside curly brackets")
+
 (* Remove patterns of the form "{ _ }", unless it is the "{ _ }" notation *)
 let remove_curly_brackets l =
   let rec skip_break acc = function
@@ -930,9 +998,10 @@ let remove_curly_brackets l =
             let br',next' = skip_break [] l' in
             (match next' with
               | Terminal "}" as t2 :: l'' as l1 ->
-                  if not (List.equal Notation.symbol_eq l l0) || not (List.equal Notation.symbol_eq l' l1) then
-                    Feedback.msg_warning (strbrk "Skipping spaces inside curly brackets");
-                  if deb && List.is_empty l'' then [t1;x;t2] else begin
+                 if not (List.equal Notation.symbol_eq l l0) ||
+		      not (List.equal Notation.symbol_eq l' l1) then
+		  warn_skip_spaces_curly ();
+		  if deb && List.is_empty l'' then [t1;x;t2] else begin
                     check_curly_brackets_notation_exists ();
                     x :: aux false l''
                   end
@@ -941,18 +1010,59 @@ let remove_curly_brackets l =
   | x :: l -> x :: aux false l
   in aux true l
 
+module SynData = struct
+
+  (* XXX: Document *)
+  type syn_data = {
+
+    (* Notation name and location *)
+    info          : notation * notation_location;
+
+    (* Fields coming from the vernac-level modifiers *)
+    only_parsing  : bool;
+    only_printing : bool;
+    compat        : compat_version option;
+    format        : string Loc.located option;
+    extra         : (string * string) list;
+
+    (* XXX: Callback to printing, must remove *)
+    msgs          : ((std_ppcmds -> unit) * std_ppcmds) list;
+
+    (* Fields for internalization *)
+    recvars       : (Id.t * Id.t) list;
+    mainvars      : Id.List.elt list;
+    intern_typs   : notation_var_internalization_type list;
+
+    (* Notation data for parsing *)
+
+    level         : int;
+    syntax_data   : (Id.t * (production_level, production_position) constr_entry_key_gen) list * (* typs    *)
+                    symbol list;                                                                 (* symbols *)
+    not_data      : notation *                   (* notation *)
+                    (int * parenRelation) list * (* precedence *)
+                    bool;                        (* needs_squash *)
+  }
+
+end
+
 let compute_syntax_data df modifiers =
-  let (assoc,n,etyps,onlyparse,fmt,extra) = interp_modifiers modifiers in
-  let assoc = match assoc with None -> (* default *) Some NonA | a -> a in
+  let open SynData in
+  let open NotationMods in
+  let mods = interp_modifiers modifiers in
+  let assoc = Option.append mods.assoc (Some NonA) in
   let toks = split_notation_string df in
-  let (recvars,mainvars,symbols) = analyze_notation_tokens toks in
-  let _ = check_useless_entry_types recvars mainvars etyps in
+  let recvars,mainvars,symbols = analyze_notation_tokens toks in
+  let _ = check_useless_entry_types recvars mainvars mods.etyps in
+
+  (* Notations for interp and grammar  *)
   let ntn_for_interp = make_notation_key symbols in
   let symbols' = remove_curly_brackets symbols in
-  let need_squash = not (List.equal Notation.symbol_eq symbols symbols') in
   let ntn_for_grammar = make_notation_key symbols' in
   check_rule_productivity symbols';
-  let msgs,n = find_precedence n etyps symbols' in
+
+  (* Misc *)
+  let need_squash = not (List.equal Notation.symbol_eq symbols symbols') in
+  let msgs,n = find_precedence mods.level mods.etyps symbols' in
   let innerlevel = NumLevel 200 in
   let typs =
     find_symbols
@@ -961,25 +1071,44 @@ let compute_syntax_data df modifiers =
       (NumLevel n,BorderProd(Right,assoc))
       symbols' in
   (* To globalize... *)
-  let etyps = join_auxiliary_recursive_types recvars etyps in
+  let etyps = join_auxiliary_recursive_types recvars mods.etyps in
   let sy_typs = List.map (set_entry_type etyps) typs in
-  let prec = (n,List.map (assoc_of_type n) sy_typs) in
+  let prec = List.map (assoc_of_type n) sy_typs in
   let i_typs = set_internalization_type sy_typs in
-  let sy_data = (n,sy_typs,symbols',fmt) in
-  let sy_fulldata = (i_typs,ntn_for_grammar,prec,need_squash,sy_data) in
+  let sy_data = (sy_typs,symbols') in
+  let sy_fulldata = (ntn_for_grammar,prec,need_squash) in
   let df' = ((Lib.library_dp(),Lib.current_dirpath true),df) in
-  let i_data = (onlyparse,recvars,mainvars,(ntn_for_interp,df')) in
+  let i_data = ntn_for_interp, df' in
+
   (* Return relevant data for interpretation and for parsing/printing *)
-  (msgs,i_data,i_typs,sy_fulldata,extra)
+  { info = i_data;
+
+    only_parsing  = mods.only_parsing;
+    only_printing = mods.only_printing;
+    compat        = mods.compat;
+    format        = mods.format;
+    extra         = mods.extra;
+
+    msgs;
+
+    recvars;
+    mainvars;
+    intern_typs = i_typs;
+
+    level  = n;
+    syntax_data = sy_data;
+    not_data    = sy_fulldata;
+  }
 
 let compute_pure_syntax_data df mods =
-  let (msgs,(onlyparse,_,_,_),_,sy_data,extra) = compute_syntax_data df mods in
+  let open SynData in
+  let sd = compute_syntax_data df mods in
   let msgs =
-    if onlyparse then
-      (Feedback.msg_warning,
-      strbrk "The only parsing modifier has no effect in Reserved Notation.")::msgs
-    else msgs in
-  msgs, sy_data, extra
+    if sd.only_parsing then
+      (Feedback.msg_warning ?loc:None,
+      strbrk "The only parsing modifier has no effect in Reserved Notation.")::sd.msgs
+    else sd.msgs in
+  { sd with msgs }
 
 (**********************************************************************)
 (* Registration of notations interpretation                            *)
@@ -989,6 +1118,8 @@ type notation_obj = {
   notobj_scope : scope_name option;
   notobj_interp : interpretation;
   notobj_onlyparse : bool;
+  notobj_onlyprint : bool;
+  notobj_compat : Flags.compat_version option;
   notobj_notation : notation * notation_location;
 }
 
@@ -999,9 +1130,12 @@ let open_notation i (_, nobj) =
   let scope = nobj.notobj_scope in
   let (ntn, df) = nobj.notobj_notation in
   let pat = nobj.notobj_interp in
-  if Int.equal i 1 && not (Notation.exists_notation_in_scope scope ntn pat) then begin
+  let fresh = not (Notation.exists_notation_in_scope scope ntn pat) in
+  let active = is_active_compat nobj.notobj_compat in
+  if Int.equal i 1 && fresh && active then begin
     (* Declare the interpretation *)
-    Notation.declare_notation_interpretation ntn scope pat df;
+    let onlyprint = nobj.notobj_onlyprint  in
+    let () = Notation.declare_notation_interpretation ntn scope pat df ~onlyprint in
     (* Declare the uninterpretation *)
     if not nobj.notobj_onlyparse then
       Notation.declare_uninterpretation (NotationRule (scope, ntn)) pat
@@ -1031,13 +1165,13 @@ let with_lib_stk_protection f x =
   let fs = Lib.freeze `No in
   try let a = f x in Lib.unfreeze fs; a
   with reraise ->
-    let reraise = Errors.push reraise in
+    let reraise = CErrors.push reraise in
     let () = Lib.unfreeze fs in
     iraise reraise
 
 let with_syntax_protection f x =
   with_lib_stk_protection
-    (with_grammar_rule_protection
+    (Pcoq.with_grammar_rule_protection
        (with_notation_protection f)) x
 
 (**********************************************************************)
@@ -1048,7 +1182,10 @@ let contract_notation ntn =
   let rec aux ntn i =
     if i <= String.length ntn - 5 then
       let ntn' =
-        if String.is_sub "{ _ }" ntn i then
+        if String.is_sub "{ _ }" ntn i &&
+           (i = 0 || ntn.[i-1] = ' ') &&
+           (i = String.length ntn - 5 || ntn.[i+5] = ' ')
+        then
           String.sub ntn 0 i ^ "_" ^
           String.sub ntn (i+5) (String.length ntn -i-5)
         else ntn in
@@ -1063,12 +1200,14 @@ let recover_syntax ntn =
     let prec = Notation.level_of_notation ntn in
     let pp_rule,_ = Notation.find_notation_printing_rule ntn in
     let pp_extra_rules = Notation.find_notation_extra_printing_rules ntn in
-    let pa_rule = Egramcoq.recover_constr_grammar ntn prec in
+    let pa_rule = Notation.find_notation_parsing_rules ntn in
     { synext_level = prec;
       synext_notation = ntn;
       synext_notgram = pa_rule;
       synext_unparsing = pp_rule;
-      synext_extra = pp_extra_rules }
+      synext_extra = pp_extra_rules;
+      synext_compat = None;
+    }
   with Not_found ->
     raise NoSyntaxRule
 
@@ -1081,34 +1220,39 @@ let recover_notation_syntax rawntn =
   let sy = recover_syntax ntn in
   let need_squash = not (String.equal ntn rawntn) in
   let rules = if need_squash then recover_squash_syntax sy else [sy] in
-  sy.synext_notgram.notgram_typs, rules
+  sy.synext_notgram.notgram_typs, rules, sy.synext_notgram.notgram_onlyprinting
 
 (**********************************************************************)
 (* Main entry point for building parsing and printing rules           *)
 
-let make_pa_rule i_typs (n,typs,symbols,_) ntn =
+let make_pa_rule i_typs level (typs,symbols) ntn onlyprint =
   let assoc = recompute_assoc typs in
   let prod = make_production typs symbols in
-  { notgram_level = n;
+  { notgram_level = level;
     notgram_assoc = assoc;
     notgram_notation = ntn;
     notgram_prods = prod;
-    notgram_typs = i_typs; }
+    notgram_typs = i_typs;
+    notgram_onlyprinting = onlyprint;
+  }
 
-let make_pp_rule (n,typs,symbols,fmt) =
+let make_pp_rule level (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 (i_typs,ntn,prec,need_squash,sy_data) extra =
-  let pa_rule = make_pa_rule i_typs sy_data ntn in
-  let pp_rule = make_pp_rule sy_data in
+  | None -> [UnpBox (PpHOVB 0, make_hunks typs symbols level)]
+  | Some fmt -> hunks_of_format (level, List.split typs) (symbols, parse_format fmt)
+
+(* let make_syntax_rules i_typs (ntn,prec,need_squash) sy_data fmt extra onlyprint compat = *)
+let make_syntax_rules (sd : SynData.syn_data) = let open SynData in
+  let ntn, prec, need_squash = sd.not_data in
+  let pa_rule = make_pa_rule sd.intern_typs sd.level sd.syntax_data ntn sd.only_printing in
+  let pp_rule = make_pp_rule sd.level sd.syntax_data sd.format in
   let sy = {
-    synext_level = prec;
+    synext_level    = (sd.level, prec);
     synext_notation = ntn;
-    synext_notgram = pa_rule;
+    synext_notgram  = pa_rule;
     synext_unparsing = pp_rule;
-    synext_extra = extra;
+    synext_extra  = sd.extra;
+    synext_compat = sd.compat;
   } 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
@@ -1123,62 +1267,67 @@ let to_map l =
   List.fold_left fold Id.Map.empty l
 
 let add_notation_in_scope local df c mods scope =
-  let (msgs,i_data,i_typs,sy_data,extra) = compute_syntax_data df mods in
-  (* Prepare the parsing and printing rules *)
-  let sy_rules = make_syntax_rules sy_data extra in
+  let open SynData in
+  let sd = compute_syntax_data df mods in
   (* Prepare the interpretation *)
-  let (onlyparse, recvars,mainvars, df') = i_data in
-  let i_vars = make_internalization_vars recvars mainvars i_typs in
+  (* Prepare the parsing and printing rules *)
+  let sy_rules = make_syntax_rules sd in
+  let i_vars = make_internalization_vars sd.recvars sd.mainvars sd.intern_typs in
   let nenv = {
     ninterp_var_type = to_map i_vars;
-    ninterp_rec_vars = to_map recvars;
-    ninterp_only_parse = false;
+    ninterp_rec_vars = to_map sd.recvars;
   } in
-  let (acvars, ac) = interp_notation_constr nenv c in
-  let interp = make_interpretation_vars recvars acvars in
+  let (acvars, ac, reversible) = interp_notation_constr nenv c in
+  let interp = make_interpretation_vars sd.recvars acvars in
   let map (x, _) = try Some (x, Id.Map.find x interp) with Not_found -> None in
-  let onlyparse = is_not_printable onlyparse nenv.ninterp_only_parse ac in
+  let onlyparse = is_not_printable sd.only_parsing (not reversible) ac in
   let notation = {
     notobj_local = local;
     notobj_scope = scope;
     notobj_interp = (List.map_filter map i_vars, ac);
     (** Order is important here! *)
     notobj_onlyparse = onlyparse;
-    notobj_notation = df';
+    notobj_onlyprint = sd.only_printing;
+    notobj_compat = sd.compat;
+    notobj_notation = sd.info;
   } in
   (* Ready to change the global state *)
-  Flags.if_verbose (List.iter (fun (f,x) -> f x)) msgs;
+  Flags.if_verbose (List.iter (fun (f,x) -> f x)) sd.msgs;
   Lib.add_anonymous_leaf (inSyntaxExtension (local, sy_rules));
   Lib.add_anonymous_leaf (inNotation notation);
-  df'
+  sd.info
 
-let add_notation_interpretation_core local df ?(impls=empty_internalization_env) c scope onlyparse =
+let add_notation_interpretation_core local df ?(impls=empty_internalization_env) c scope onlyparse onlyprint compat =
   let dfs = split_notation_string df in
-  let (recvars,mainvars,symbs) = analyze_notation_tokens dfs in
+  let recvars,mainvars,symbs = analyze_notation_tokens dfs in
   (* Recover types of variables and pa/pp rules; redeclare them if needed *)
-  let i_typs = if not (is_numeral symbs) then begin
-    let i_typs,sy_rules = recover_notation_syntax (make_notation_key symbs) in
-    Lib.add_anonymous_leaf (inSyntaxExtension (local,sy_rules)); i_typs
-  end else [] in
+  let i_typs, onlyprint = if not (is_numeral symbs) then begin
+    let i_typs,sy_rules,onlyprint' = recover_notation_syntax (make_notation_key symbs) in
+    let () = Lib.add_anonymous_leaf (inSyntaxExtension (local,sy_rules)) in
+    (** If the only printing flag has been explicitly requested, put it back *)
+    let onlyprint = onlyprint || onlyprint' in
+    i_typs, onlyprint
+  end else [], false in
   (* Declare interpretation *)
-  let path = (Lib.library_dp(),Lib.current_dirpath true) in
-  let df' = (make_notation_key symbs,(path,df)) in
+  let path = (Lib.library_dp(), Lib.current_dirpath true) in
+  let df'  = (make_notation_key symbs, (path,df)) in
   let i_vars = make_internalization_vars recvars mainvars i_typs in
   let nenv = {
     ninterp_var_type = to_map i_vars;
     ninterp_rec_vars = to_map recvars;
-    ninterp_only_parse = false;
   } in
-  let (acvars, ac) = interp_notation_constr ~impls nenv c in
+  let (acvars, ac, reversible) = interp_notation_constr ~impls nenv c in
   let interp = make_interpretation_vars recvars acvars in
   let map (x, _) = try Some (x, Id.Map.find x interp) with Not_found -> None in
-  let onlyparse = is_not_printable onlyparse nenv.ninterp_only_parse ac in
+  let onlyparse = is_not_printable onlyparse (not reversible) ac in
   let notation = {
     notobj_local = local;
     notobj_scope = scope;
     notobj_interp = (List.map_filter map i_vars, ac);
     (** Order is important here! *)
     notobj_onlyparse = onlyparse;
+    notobj_onlyprint = onlyprint;
+    notobj_compat = compat;
     notobj_notation = df';
   } in
   Lib.add_anonymous_leaf (inNotation notation);
@@ -1186,21 +1335,21 @@ let add_notation_interpretation_core local df ?(impls=empty_internalization_env)
 
 (* Notations without interpretation (Reserved Notation) *)
 
-let add_syntax_extension local ((loc,df),mods) =
-  let msgs, sy_data, extra = compute_pure_syntax_data df mods in
-  let sy_rules = make_syntax_rules sy_data extra in
-  Flags.if_verbose (List.iter (fun (f,x) -> f x)) msgs;
+let add_syntax_extension local ((loc,df),mods) = let open SynData in
+  let psd = compute_pure_syntax_data df mods in
+  let sy_rules = make_syntax_rules {psd with compat = None} in
+  Flags.if_verbose (List.iter (fun (f,x) -> f x)) psd.msgs;
   Lib.add_anonymous_leaf (inSyntaxExtension(local,sy_rules))
 
 (* Notations with only interpretation *)
 
 let add_notation_interpretation ((loc,df),c,sc) =
-  let df' = add_notation_interpretation_core false df c sc false in
+  let df' = add_notation_interpretation_core false df c sc false false None in
   Dumpglob.dump_notation (loc,df') sc true
 
 let set_notation_for_interpretation impls ((_,df),c,sc) =
   (try ignore
-    (silently (add_notation_interpretation_core false df ~impls c sc) false);
+    (silently (fun () -> add_notation_interpretation_core false df ~impls c sc false false None) ());
   with NoSyntaxRule ->
     error "Parsing rule for this notation has to be previously declared.");
   Option.iter (fun sc -> Notation.open_close_scope (false,true,sc)) sc
@@ -1212,7 +1361,9 @@ let add_notation local c ((loc,df),modifiers) sc =
    if no_syntax_modifiers modifiers then
     (* No syntax data: try to rely on a previously declared rule *)
     let onlyparse = is_only_parsing modifiers in
-    try add_notation_interpretation_core local df c sc onlyparse
+    let onlyprint = is_only_printing modifiers in
+    let compat = get_compat_version modifiers in
+    try add_notation_interpretation_core local df c sc onlyparse onlyprint compat
     with NoSyntaxRule ->
       (* Try to determine a default syntax rule *)
       add_notation_in_scope local df c modifiers sc
@@ -1305,10 +1456,9 @@ let add_syntactic_definition ident (vars,c) local onlyparse =
       let nenv = {
         ninterp_var_type = i_vars;
         ninterp_rec_vars = Id.Map.empty;
-        ninterp_only_parse = false;
       } in
-      let nvars, pat = interp_notation_constr nenv c in
-      let () = nonprintable := nenv.ninterp_only_parse in
+      let nvars, pat, reversible = interp_notation_constr nenv c in
+      let () = nonprintable := not reversible in
       let map id = let (_,sc,_) = Id.Map.find id nvars in (id, sc) in
       List.map map vars, pat
   in
@@ -1317,4 +1467,3 @@ let add_syntactic_definition ident (vars,c) local onlyparse =
     | p -> p
   in
   Syntax_def.declare_syntactic_definition local ident onlyparse (vars,pat)
-
diff --git a/toplevel/metasyntax.mli b/vernac/metasyntax.mli
index 085cc87c8..57c120402 100644
--- a/toplevel/metasyntax.mli
+++ b/vernac/metasyntax.mli
@@ -7,7 +7,6 @@
 (************************************************************************)
 
 open Names
-open Tacexpr
 open Vernacexpr
 open Notation
 open Constrexpr
@@ -55,6 +54,10 @@ val add_syntactic_definition : Id.t -> Id.t list * constr_expr ->
 
 val pr_grammar : string -> Pp.std_ppcmds
 
+type any_entry = AnyEntry : 'a Pcoq.Gram.entry -> any_entry
+
+val register_grammar : string -> any_entry list -> unit
+
 val check_infix_modifiers : syntax_modifier list -> unit
 
 val with_syntax_protection : ('a -> 'b) -> 'a -> 'b
diff --git a/toplevel/mltop.ml b/vernac/mltop.ml
index 36c16208c..2396cf04a 100644
--- a/toplevel/mltop.ml
+++ b/vernac/mltop.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-open Errors
+open CErrors
 open Util
 open Pp
 open Flags
@@ -45,12 +45,12 @@ open System
    to build a dummy dynlink.cmxa, cf. dev/dynlink.ml. *)
 
 (* This path is where we look for .cmo *)
-let coq_mlpath_copy = ref ["."]
+let coq_mlpath_copy = ref [Sys.getcwd ()]
 let keep_copy_mlpath path =
   let cpath = CUnix.canonical_path_name path in
-  let filter path' = not (String.equal cpath (CUnix.canonical_path_name path'))
+  let filter path' = not (String.equal cpath path')
   in
-  coq_mlpath_copy := path :: List.filter filter !coq_mlpath_copy
+  coq_mlpath_copy := cpath :: List.filter filter !coq_mlpath_copy
 
 (* If there is a toplevel under Coq *)
 type toplevel = {
@@ -118,19 +118,19 @@ let ml_load s =
     | WithTop t ->
       (try t.load_obj s; s
        with
-       | e when Errors.noncritical e ->
-        let e = Errors.push e in
+       | e when CErrors.noncritical e ->
+        let e = CErrors.push e in
         match fst e with
         | (UserError _ | Failure _ | Not_found as u) -> Exninfo.iraise (u, snd e)
         | exc ->
             let msg = report_on_load_obj_error exc in
-            errorlabstrm "Mltop.load_object" (str"Cannot link ml-object " ++
+            user_err ~hdr:"Mltop.load_object" (str"Cannot link ml-object " ++
                   str s ++ str" to Coq code (" ++ msg ++ str ")."))
     | WithoutTop ->
         try
           Dynlink.loadfile s; s
 	with Dynlink.Error a ->
-          errorlabstrm "Mltop.load_object"
+          user_err ~hdr:"Mltop.load_object"
             (strbrk "while loading " ++ str s ++
              strbrk ": " ++ str (Dynlink.error_message a))
 
@@ -146,7 +146,12 @@ let dir_ml_load s =
 let dir_ml_use s =
   match !load with
     | WithTop t -> t.use_file s
-    | _ -> Feedback.msg_warning (str "Cannot access the ML compiler")
+    | _ ->
+       let moreinfo =
+	 if Dynlink.is_native then " Loading ML code works only in bytecode."
+	 else ""
+       in
+      user_err ~hdr:"Mltop.dir_ml_use" (str "Could not load ML code." ++ str moreinfo)
 
 (* Adds a path to the ML paths *)
 let add_ml_dir s =
@@ -161,13 +166,25 @@ let add_rec_ml_dir unix_path =
 
 (* Adding files to Coq and ML loadpath *)
 
+let warn_cannot_use_directory =
+  CWarnings.create ~name:"cannot-use-directory" ~category:"filesystem"
+         (fun d ->
+          str "Directory " ++ str d ++
+            strbrk " cannot be used as a Coq identifier (skipped)")
+
 let convert_string d =
   try Names.Id.of_string d
   with UserError _ ->
-    Feedback.msg_warning (str "Directory " ++ str d ++ str " cannot be used as a Coq identifier (skipped)");
+    warn_cannot_use_directory d;
     raise Exit
 
-let add_rec_path ~unix_path ~coq_root ~implicit =
+let warn_cannot_open_path =
+  CWarnings.create ~name:"cannot-open-path" ~category:"filesystem"
+      (fun unix_path -> str "Cannot open " ++ str unix_path)
+
+type add_ml = AddNoML | AddTopML | AddRecML
+
+let add_rec_path add_ml ~unix_path ~coq_root ~implicit =
   if exists_dir unix_path then
     let dirs = all_subdirs ~unix_path in
     let prefix = Names.DirPath.repr coq_root in
@@ -178,13 +195,16 @@ let add_rec_path ~unix_path ~coq_root ~implicit =
       with Exit -> None
     in
     let dirs = List.map_filter convert_dirs dirs in
-    let () = add_ml_dir unix_path in
+    let () = match add_ml with
+      | AddNoML -> ()
+      | AddTopML -> add_ml_dir unix_path
+      | AddRecML -> List.iter (fun (lp,_) -> add_ml_dir lp) dirs in
     let add (path, dir) =
       Loadpath.add_load_path path ~implicit dir in
     let () = List.iter add dirs in
     Loadpath.add_load_path unix_path ~implicit coq_root
   else
-    Feedback.msg_warning (str "Cannot open " ++ str unix_path)
+    warn_cannot_open_path unix_path
 
 (* convertit un nom quelconque en nom de fichier ou de module *)
 let mod_of_name name =
@@ -206,7 +226,7 @@ let get_ml_object_suffix name =
 let file_of_name name =
   let suffix = get_ml_object_suffix name in
   let fail s =
-    errorlabstrm "Mltop.load_object"
+    user_err ~hdr:"Mltop.load_object"
       (str"File not found on loadpath : " ++ str s ++ str"\n" ++
        str"Loadpath: " ++ str(String.concat ":" !coq_mlpath_copy)) in
   if not (Filename.is_relative name) then
@@ -340,7 +360,7 @@ let trigger_ml_object verb cache reinit ?path name =
     add_loaded_module name (known_module_path name);
     if cache then perform_cache_obj name
   end else if not has_dynlink then
-    errorlabstrm "Mltop.trigger_ml_object"
+    user_err ~hdr:"Mltop.trigger_ml_object"
       (str "Dynamic link not supported (module " ++ str name ++ str ")")
   else begin
     let file = file_of_name (Option.default name path) in
@@ -391,7 +411,7 @@ let inMLModule : ml_module_object -> obj =
 
 let declare_ml_modules local l =
   let l = List.map mod_of_name l in
-  Lib.add_anonymous_leaf (inMLModule {mlocal=local; mnames=l})
+  Lib.add_anonymous_leaf ~cache_first:false (inMLModule {mlocal=local; mnames=l})
 
 let print_ml_path () =
   let l = !coq_mlpath_copy in
diff --git a/toplevel/mltop.mli b/vernac/mltop.mli
index 5d0546824..6633cb937 100644
--- a/toplevel/mltop.mli
+++ b/vernac/mltop.mli
@@ -46,8 +46,10 @@ val dir_ml_use : string -> unit
 val add_ml_dir : string -> unit
 val add_rec_ml_dir : string -> unit
 
+type add_ml = AddNoML | AddTopML | AddRecML
+
 (** Adds a path to the Coq and ML paths *)
-val add_rec_path : unix_path:string -> coq_root:Names.DirPath.t -> implicit:bool -> unit
+val add_rec_path : add_ml -> unix_path:string -> coq_root:Names.DirPath.t -> implicit:bool -> unit
 
 (** List of modules linked to the toplevel *)
 val add_known_module : string -> unit
diff --git a/toplevel/obligations.ml b/vernac/obligations.ml
index dbc3ccaac..6f3921903 100644
--- a/toplevel/obligations.ml
+++ b/vernac/obligations.ml
@@ -17,15 +17,15 @@ open Vars
 open Names
 open Evd
 open Pp
-open Errors
+open CErrors
 open Util
 
+module NamedDecl = Context.Named.Declaration
+
 let declare_fix_ref = ref (fun ?opaque _ _ _ _ _ _ -> assert false)
 let declare_definition_ref = ref (fun _ _ _ _ _ -> assert false)
 
-let trace s =
-  if !Flags.debug then Feedback.msg_debug s
-  else ()
+let get_fix_exn, stm_get_fix_exn = Hook.make ()
 
 let succfix (depth, fixrels) =
   (succ depth, List.map succ fixrels)
@@ -38,13 +38,13 @@ let check_evars env evm =
      | Evar_kinds.QuestionMark _
      | Evar_kinds.ImplicitArg (_,_,false) -> ()
      | _ ->
-       Pretype_errors.error_unsolvable_implicit loc env evm key None)
+       Pretype_errors.error_unsolvable_implicit ~loc env evm key None)
   (Evd.undefined_map evm)
 
 type oblinfo =
   { ev_name: int * Id.t;
     ev_hyps: Context.Named.t;
-    ev_status: Evar_kinds.obligation_definition_status;
+    ev_status: bool * Evar_kinds.obligation_definition_status;
     ev_chop: int option;
     ev_src: Evar_kinds.t Loc.located;
     ev_typ: types;
@@ -55,7 +55,6 @@ type oblinfo =
   where n binders were passed through. *)
 
 let subst_evar_constr evs n idf t =
-  let open Context.Named.Declaration in
   let seen = ref Int.Set.empty in
   let transparent = ref Id.Set.empty in
   let evar_info id = List.assoc_f Evar.equal id evs in
@@ -78,6 +77,7 @@ let subst_evar_constr evs n idf t =
 	in
 	let args =
 	  let rec aux hyps args acc =
+             let open Context.Named.Declaration in
 	     match hyps, args with
 		 (LocalAssum _ :: tlh), (c :: tla) ->
 		   aux tlh tla ((substrec (depth, fixrels) c) :: acc)
@@ -120,9 +120,9 @@ let etype_of_evar evs hyps concl =
   let open Context.Named.Declaration in
   let rec aux acc n = function
       decl :: tl ->
-	let t', s, trans = subst_evar_constr evs n mkVar (get_type decl) in
+	let t', s, trans = subst_evar_constr evs n mkVar (NamedDecl.get_type decl) in
 	let t'' = subst_vars acc 0 t' in
-	let rest, s', trans' = aux (get_id decl :: acc) (succ n) tl in
+	let rest, s', trans' = aux (NamedDecl.get_id decl :: acc) (succ n) tl in
 	let s' = Int.Set.union s s' in
 	let trans' = Id.Set.union trans trans' in
 	  (match decl with
@@ -219,16 +219,20 @@ let eterm_obligations env name evm fs ?status t ty =
 	   | None -> evtyp, hyps, 0
 	 in
 	 let loc, k = evar_source id evm in
-	 let status = match k with Evar_kinds.QuestionMark o -> Some o | _ -> status in
-	 let status, chop = match status with
-	   | Some (Evar_kinds.Define true as stat) ->
-	       if not (Int.equal chop fs) then Evar_kinds.Define false, None
-	       else stat, Some chop
-	   | Some s -> s, None
-	   | None -> Evar_kinds.Define true, None
+	 let status = match k with
+           | Evar_kinds.QuestionMark o -> o
+           | _ -> match status with
+                 | Some o -> o
+                 | None -> Evar_kinds.Define (not (Program.get_proofs_transparency ()))
+         in
+         let force_status, status, chop = match status with
+	   | Evar_kinds.Define true as stat ->
+	      if not (Int.equal chop fs) then true, Evar_kinds.Define false, None
+	      else false, stat, Some chop
+	   | s -> false, s, None
 	 in
 	 let info = { ev_name = (n, nstr);
-		      ev_hyps = hyps; ev_status = status; ev_chop = chop;
+		      ev_hyps = hyps; ev_status = force_status, status; ev_chop = chop;
 		      ev_src = loc, k; ev_typ = evtyp ; ev_deps = deps; ev_tac = None }
 	 in (id, info) :: l)
       evn []
@@ -239,14 +243,14 @@ let eterm_obligations env name evm fs ?status t ty =
   let ty, _, _ = subst_evar_constr evts 0 mkVar ty in
   let evars = 
     List.map (fun (ev, info) ->
-      let { ev_name = (_, name); ev_status = status;
+      let { ev_name = (_, name); ev_status = force_status, status;
 	    ev_src = src; ev_typ = typ; ev_deps = deps; ev_tac = tac } = info
       in
-      let status = match status with
+      let force_status, status = match status with
 	| Evar_kinds.Define true when Id.Set.mem name transparent ->
-	  Evar_kinds.Define false
-	| _ -> status
-      in name, typ, src, status, deps, tac) evts
+	  true, Evar_kinds.Define false
+	| _ -> force_status, status
+      in name, typ, src, (force_status, status), deps, tac) evts
   in
   let evnames = List.map (fun (ev, info) -> ev, snd info.ev_name) evts in
   let evmap f c = pi1 (subst_evar_constr evts 0 f c) in
@@ -258,11 +262,11 @@ let safe_init_constant md name () =
   Coqlib.gen_constant "Obligations" md name
 let hide_obligation = safe_init_constant tactics_module "obligation"
 
-let pperror cmd = Errors.errorlabstrm "Program" cmd
+let pperror cmd = CErrors.user_err ~hdr:"Program" cmd
 let error s = pperror (str s)
 
 let reduce c =
-  Reductionops.clos_norm_flags Closure.betaiota (Global.env ()) Evd.empty c
+  Reductionops.clos_norm_flags CClosure.betaiota (Global.env ()) Evd.empty c
 
 exception NoObligations of Id.t option
 
@@ -272,7 +276,8 @@ let explain_no_obligations = function
 
 type obligation_info =
     (Names.Id.t * Term.types * Evar_kinds.t Loc.located *
-     Evar_kinds.obligation_definition_status * Int.Set.t * unit Proofview.tactic option) array
+       (bool * Evar_kinds.obligation_definition_status)
+       * Int.Set.t * unit Proofview.tactic option) array
 
 type 'a obligation_body = 
   | DefinedObl of 'a
@@ -283,7 +288,7 @@ type obligation =
     obl_type : types;
     obl_location : Evar_kinds.t Loc.located;
     obl_body : constant obligation_body option;
-    obl_status : Evar_kinds.obligation_definition_status;
+    obl_status : bool * Evar_kinds.obligation_definition_status;
     obl_deps : Int.Set.t;
     obl_tac : unit Proofview.tactic option;
   }
@@ -319,35 +324,19 @@ type program_info = program_info_aux CEphemeron.key
 let get_info x =
   try CEphemeron.get x
   with CEphemeron.InvalidKey ->
-    Errors.anomaly Pp.(str "Program obligation can't be accessed by a worker")
+    CErrors.anomaly Pp.(str "Program obligation can't be accessed by a worker")
 
 let assumption_message = Declare.assumption_message
 
 let default_tactic = ref (Proofview.tclUNIT ())
 
-(* true = All transparent, false = Opaque if possible *)
-let proofs_transparency = ref true
-
-let set_proofs_transparency = (:=) proofs_transparency
-let get_proofs_transparency () = !proofs_transparency
-
-open Goptions
-
-let _ =
-  declare_bool_option
-    { optsync  = true;
-      optdepr  = false;
-      optname  = "transparency of Program obligations";
-      optkey   = ["Transparent";"Obligations"];
-      optread  = get_proofs_transparency;
-      optwrite = set_proofs_transparency; }
-
 (* true = hide obligations *)
 let hide_obligations = ref false
 
 let set_hide_obligations = (:=) hide_obligations
 let get_hide_obligations () = !hide_obligations
 
+open Goptions
 let _ =
   declare_bool_option
     { optsync  = true;
@@ -357,7 +346,7 @@ let _ =
       optread  = get_hide_obligations;
       optwrite = set_hide_obligations; }
 
-let shrink_obligations = ref false
+let shrink_obligations = ref true
 
 let set_shrink_obligations = (:=) shrink_obligations
 let get_shrink_obligations () = !shrink_obligations
@@ -365,7 +354,7 @@ let get_shrink_obligations () = !shrink_obligations
 let _ =
   declare_bool_option
     { optsync  = true;
-      optdepr  = false;
+      optdepr  = true;
       optname  = "Shrinking of Program obligations";
       optkey   = ["Shrink";"Obligations"];
       optread  = get_shrink_obligations;
@@ -373,36 +362,35 @@ let _ =
 
 let evar_of_obligation o = make_evar (Global.named_context_val ()) o.obl_type
 
-let get_body obl = 
+let get_body obl =
   match obl.obl_body with
-  | None -> assert false
+  | None -> None
   | Some (DefinedObl c) ->
     let ctx = Environ.constant_context (Global.env ()) c in
     let pc = (c, Univ.UContext.instance ctx) in
-      DefinedObl pc
-  | Some (TermObl c) -> 
-      TermObl c
+      Some (DefinedObl pc)
+  | Some (TermObl c) ->
+      Some (TermObl c)
 
 let get_obligation_body expand obl =
-  let c = get_body obl in
-  let c' = 
-    if expand && obl.obl_status == Evar_kinds.Expand then
-      (match c with
-      | DefinedObl pc -> constant_value_in (Global.env ()) pc
-      | TermObl c -> c)
-    else (match c with
-    | DefinedObl pc -> mkConstU pc
-    | TermObl c -> c)
-  in c'
+  match get_body obl with
+  | None -> None
+  | Some c ->
+     if expand && snd obl.obl_status == Evar_kinds.Expand then
+       match c with
+       | DefinedObl pc -> Some (constant_value_in (Global.env ()) pc)
+       | TermObl c -> Some c
+     else (match c with
+	   | DefinedObl pc -> Some (mkConstU pc)
+	   | TermObl c -> Some c)
 
 let obl_substitution expand obls deps =
   Int.Set.fold
     (fun x acc ->
        let xobl = obls.(x) in
-       let oblb =
-	 try get_obligation_body expand xobl
-	 with e when Errors.noncritical e -> assert false
-       in (xobl.obl_name, (xobl.obl_type, oblb)) :: acc)
+       match get_obligation_body expand xobl with
+       | None -> acc
+       | Some oblb -> (xobl.obl_name, (xobl.obl_type, oblb)) :: acc)
     deps []
 
 let subst_deps expand obls deps t =
@@ -410,11 +398,11 @@ let subst_deps expand obls deps t =
     (Vars.replace_vars (List.map (fun (n, (_, b)) -> n, b) osubst) t)
 
 let rec prod_app t n =
-  match kind_of_term (strip_outer_cast t) with
+  match kind_of_term (Termops.strip_outer_cast t) with
     | Prod (_,_,b) -> subst1 n b
     | LetIn (_, b, t, b') -> prod_app (subst1 b b') n
     | _ ->
-	errorlabstrm "prod_app"
+	user_err ~hdr:"prod_app"
 	  (str"Needed a product, but didn't find one" ++ fnl ())
 
 
@@ -460,7 +448,7 @@ let from_prg : program_info ProgMap.t ref =
 let close sec =
   if not (ProgMap.is_empty !from_prg) then
     let keys = map_keys !from_prg in
-      errorlabstrm "Program" 
+      user_err ~hdr:"Program" 
 	(str "Unsolved obligations when closing " ++ str sec ++ str":" ++ spc () ++
 	   prlist_with_sep spc (fun x -> Nameops.pr_id x) keys ++
 	   (str (if Int.equal (List.length keys) 1 then " has " else " have ") ++
@@ -499,7 +487,7 @@ let declare_definition prg =
   let nf = Universes.nf_evars_and_universes_opt_subst (fun x -> None)
     (Evd.evar_universe_context_subst prg.prg_ctx) in
   let opaque = prg.prg_opaque in
-  let fix_exn = Stm.get_fix_exn () in
+  let fix_exn = Hook.get get_fix_exn () in
   let pl, ctx =
     Evd.universe_context ?names:prg.prg_pl (Evd.from_ctx prg.prg_ctx) in
   let ce =
@@ -567,7 +555,8 @@ let declare_mutual_definition l =
 	    List.map3 compute_possible_guardness_evidences
               wfl fixdefs fixtypes in
 	  let indexes = 
-            Pretyping.search_guard Loc.ghost (Global.env())
+              Pretyping.search_guard
+              Loc.ghost (Global.env())
               possible_indexes fixdecls in
           Some indexes, 
           List.map_i (fun i _ ->
@@ -579,7 +568,7 @@ let declare_mutual_definition l =
   in
   (* Declare the recursive definitions *)
   let ctx = Evd.evar_context_universe_context first.prg_ctx in
-  let fix_exn = Stm.get_fix_exn () in
+  let fix_exn = Hook.get get_fix_exn () in
   let kns = List.map4 (!declare_fix_ref ~opaque (local, poly, kind) ctx)
     fixnames fixdecls fixtypes fiximps in
     (* Declare notations *)
@@ -590,18 +579,49 @@ let declare_mutual_definition l =
     Lemmas.call_hook fix_exn first.prg_hook local gr first.prg_ctx;
     List.iter progmap_remove l; kn
 
-let shrink_body c =
+let decompose_lam_prod c ty =
   let open Context.Rel.Declaration in
-  let ctx, b = decompose_lam_assum c in
-  let b', n, args = 
-    List.fold_left (fun (b, i, args) decl ->
-      if noccurn 1 b then 
-	subst1 mkProp b, succ i, args
-      else
-	let args = if is_local_assum decl then mkRel i :: args else args in
-        mkLambda_or_LetIn decl b, succ i, args)
-     (b, 1, []) ctx
-  in ctx, b', Array.of_list args
+  let rec aux ctx c ty =
+    match kind_of_term c, kind_of_term ty with
+    | LetIn (x, b, t, c), LetIn (x', b', t', ty)
+	 when eq_constr b b' && eq_constr t t' ->
+       let ctx' = Context.Rel.add (LocalDef (x,b',t')) ctx in
+       aux ctx' c ty
+    | _, LetIn (x', b', t', ty) ->
+       let ctx' = Context.Rel.add (LocalDef (x',b',t')) ctx in
+       aux ctx' (lift 1 c) ty
+    | LetIn (x, b, t, c), _ ->
+       let ctx' = Context.Rel.add (LocalDef (x,b,t)) ctx in
+       aux ctx' c (lift 1 ty)
+    | Lambda (x, b, t), Prod (x', b', t')
+       (* By invariant, must be convertible *) ->
+       let ctx' = Context.Rel.add (LocalAssum (x,b')) ctx in
+       aux ctx' t t'
+    | Cast (c, _, _), _ -> aux ctx c ty
+    | _, _ -> ctx, c, ty
+  in aux Context.Rel.empty c ty
+
+let shrink_body c ty =
+  let ctx, b, ty =
+    match ty with
+    | None ->
+       let ctx, b = decompose_lam_assum c in
+       ctx, b, None
+    | Some ty ->
+       let ctx, b, ty = decompose_lam_prod c ty in
+       ctx, b, Some ty
+  in
+  let b', ty', n, args =
+    List.fold_left (fun (b, ty, i, args) decl ->
+        if noccurn 1 b && Option.cata (noccurn 1) true ty then
+	  subst1 mkProp b, Option.map (subst1 mkProp) ty, succ i, args
+	else
+          let open Context.Rel.Declaration in
+	  let args = if is_local_assum decl then mkRel i :: args else args in
+          mkLambda_or_LetIn decl b, Option.map (mkProd_or_LetIn decl) ty,
+	  succ i, args)
+     (b, ty, 1, []) ctx
+  in ctx, b', ty', Array.of_list args
 
 let unfold_entry cst = Hints.HintsUnfoldEntry [EvalConstRef cst]
 
@@ -612,47 +632,47 @@ let declare_obligation prg obl body ty uctx =
   let body = prg.prg_reduce body in
   let ty = Option.map prg.prg_reduce ty in
   match obl.obl_status with
-  | Evar_kinds.Expand -> false, { obl with obl_body = Some (TermObl body) }
-  | Evar_kinds.Define opaque ->
-      let opaque = if get_proofs_transparency () then false else opaque in
+  | _, Evar_kinds.Expand -> false, { obl with obl_body = Some (TermObl body) }
+  | force, Evar_kinds.Define opaque ->
+      let opaque = not force && opaque in
       let poly = pi2 prg.prg_kind in
-      let ctx, body, args = 
+      let ctx, body, ty, args =
 	if get_shrink_obligations () && not poly then
-	  shrink_body body else [], body, [||] 
+	  shrink_body body ty else [], body, ty, [||]
       in
       let body = ((body,Univ.ContextSet.empty),Safe_typing.empty_private_constants) in
-      let ce = 
+      let ce =
         { const_entry_body = Future.from_val ~fix_exn:(fun x -> x) body;
           const_entry_secctx = None;
-	  const_entry_type = if List.is_empty ctx then ty else None;
+	  const_entry_type = ty;
 	  const_entry_polymorphic = poly;
 	  const_entry_universes = uctx;
 	  const_entry_opaque = opaque;
           const_entry_inline_code = false;
           const_entry_feedback = None;
       } in
-    (** ppedrot: seems legit to have obligations as local *)
+      (** ppedrot: seems legit to have obligations as local *)
       let constant = Declare.declare_constant obl.obl_name ~local:true
 	(DefinitionEntry ce,IsProof Property)
       in
 	if not opaque then add_hint false prg constant;
 	definition_message obl.obl_name;
 	true, { obl with obl_body =
-	    if poly then 
+	    if poly then
 	      Some (DefinedObl constant)
 	    else
 	      Some (TermObl (it_mkLambda_or_LetIn (mkApp (mkConst constant, args)) ctx)) }
 
 let init_prog_info ?(opaque = false) sign n pl b t ctx deps fixkind
 		   notations obls impls kind reduce hook =
-  let obls', b = 
+  let obls', b =
     match b with
     | None ->
 	assert(Int.equal (Array.length obls) 0);
 	let n = Nameops.add_suffix n "_obligation" in
 	  [| { obl_name = n; obl_body = None;
 	       obl_location = Loc.ghost, Evar_kinds.InternalHole; obl_type = t;
-	       obl_status = Evar_kinds.Expand; obl_deps = Int.Set.empty;
+	       obl_status = false, Evar_kinds.Expand; obl_deps = Int.Set.empty;
 	       obl_tac = None } |],
 	mkVar n
     | Some b ->
@@ -702,7 +722,7 @@ let get_prog name =
                 let progs = Id.Set.elements (ProgMap.domain prg_infos) in
                 let prog = List.hd progs in
                 let progs = prlist_with_sep pr_comma Nameops.pr_id progs in
-                errorlabstrm ""
+                user_err 
                   (str "More than one program with unsolved obligations: " ++ progs
                   ++ str "; use the \"of\" clause to specify, as in \"Obligation 1 of " ++ Nameops.pr_id prog ++ str "\""))
 
@@ -809,7 +829,7 @@ let solve_by_tac name evi t poly ctx =
   Inductiveops.control_only_guard (Global.env ()) (fst body);
   (fst body), entry.const_entry_type, Evd.evar_universe_context ctx'
 
-let obligation_terminator name num guard hook pf =
+let obligation_terminator name num guard hook auto pf =
   let open Proof_global in
   let term = Lemmas.universe_proof_terminator guard hook in
   match pf with
@@ -820,33 +840,53 @@ let obligation_terminator name num guard hook pf =
       let (_, (entry, uctx, _)) = Pfedit.cook_this_proof proof in
       let env = Global.env () in
       let entry = Safe_typing.inline_private_constants_in_definition_entry env entry in
-      let ty = entry.Entries.const_entry_type  in
+      let ty = entry.Entries.const_entry_type in
       let (body, cstr), eff = Future.force entry.Entries.const_entry_body in
       assert(Safe_typing.empty_private_constants = eff);
-      assert(Univ.ContextSet.is_empty cstr);
+      let sigma = Evd.from_ctx (fst uctx) in
+      let sigma = Evd.merge_context_set ~sideff:true Evd.univ_rigid sigma cstr in
       Inductiveops.control_only_guard (Global.env ()) body;
       (** Declare the obligation ourselves and drop the hook *)
       let prg = get_info (ProgMap.find name !from_prg) in
-      let prg = { prg with prg_ctx = fst uctx } in
+      let ctx = Evd.evar_universe_context sigma in
+      let prg = { prg with prg_ctx = ctx } in
       let obls, rem = prg.prg_obligations in
       let obl = obls.(num) in
-      let ctx = Evd.evar_context_universe_context (fst uctx) in
-      let (_, obl) = declare_obligation prg obl body ty ctx in
+      let status =
+        match obl.obl_status, opq with
+        | (_, Evar_kinds.Expand), Vernacexpr.Opaque _ -> err_not_transp ()
+        | (true, _), Vernacexpr.Opaque _ -> err_not_transp ()
+        | (false, _), Vernacexpr.Opaque _ -> Evar_kinds.Define true
+        | (_, Evar_kinds.Define true), Vernacexpr.Transparent -> Evar_kinds.Define false
+        | (_, status), Vernacexpr.Transparent -> status
+      in
+      let obl = { obl with obl_status = false, status } in
+      let uctx = Evd.evar_context_universe_context ctx in
+      let (_, obl) = declare_obligation prg obl body ty uctx in
       let obls = Array.copy obls in
       let _ = obls.(num) <- obl in
-      try ignore (update_obls prg obls (pred rem))
-      with e when Errors.noncritical e ->
-        let e = Errors.push e in
-        pperror (Errors.iprint (Cerrors.process_vernac_interp_error e))
+      try
+      ignore (update_obls prg obls (pred rem));
+      if pred rem > 0 then
+        begin
+	  let deps = dependencies obls num in
+	  if not (Int.Set.is_empty deps) then
+	    ignore (auto (Some name) None deps)
+	end
+      with e when CErrors.noncritical e ->
+        let e = CErrors.push e in
+        pperror (CErrors.iprint (ExplainErr.process_vernac_interp_error e))
 
 let obligation_hook prg obl num auto ctx' _ gr =
   let obls, rem = prg.prg_obligations in
   let cst = match gr with ConstRef cst -> cst | _ -> assert false in
   let transparent = evaluable_constant cst (Global.env ()) in
   let () = match obl.obl_status with
-  | Evar_kinds.Expand -> if not transparent then err_not_transp ()
-  | Evar_kinds.Define op -> if not op && not transparent then err_not_transp ()
-  in
+      (true, Evar_kinds.Expand) 
+    | (true, Evar_kinds.Define true) ->
+       if not transparent then err_not_transp ()
+    | _ -> ()
+in
   let obl = { obl with obl_body = Some (DefinedObl cst) } in
   let () = if transparent then add_hint true prg cst in
   let obls = Array.copy obls in
@@ -864,9 +904,9 @@ let obligation_hook prg obl num auto ctx' _ gr =
   let prg = { prg with prg_ctx = ctx' } in
   let () =
     try ignore (update_obls prg obls (pred rem))
-    with e when Errors.noncritical e ->
-      let e = Errors.push e in
-      pperror (Errors.iprint (Cerrors.process_vernac_interp_error e))
+    with e when CErrors.noncritical e ->
+      let e = CErrors.push e in
+      pperror (CErrors.iprint (ExplainErr.process_vernac_interp_error e))
   in
   if pred rem > 0 then begin
     let deps = dependencies obls num in
@@ -887,15 +927,15 @@ let rec solve_obligation prg num tac =
         ++ str (string_of_list ", " (fun x -> string_of_int (succ x)) remaining));
   in
   let obl = subst_deps_obl obls obl in
-  let kind = kind_of_obligation (pi2 prg.prg_kind) obl.obl_status in
+  let kind = kind_of_obligation (pi2 prg.prg_kind) (snd obl.obl_status) in
   let evd = Evd.from_ctx prg.prg_ctx in
   let evd = Evd.update_sigma_env evd (Global.env ()) in
   let auto n tac oblset = auto_solve_obligations n ~oblset tac in
-  let terminator guard hook = Proof_global.make_terminator (obligation_terminator prg.prg_name num guard hook) in
+  let terminator guard hook =
+    Proof_global.make_terminator
+      (obligation_terminator prg.prg_name num guard hook auto) in
   let hook ctx = Lemmas.mk_hook (obligation_hook prg obl num auto ctx) in
   let () = Lemmas.start_proof_univs ~sign:prg.prg_sign obl.obl_name kind evd obl.obl_type ~terminator hook in
-  let () = trace (str "Started obligation " ++ int user_num ++ str "  proof: " ++
-            Printer.pr_constr_env (Global.env ()) Evd.empty obl.obl_type) in
   let _ = Pfedit.by !default_tactic in
   Option.iter (fun tac -> Pfedit.set_end_tac tac) tac
 
@@ -914,7 +954,7 @@ and obligation (user_num, name, typ) tac =
 and solve_obligation_by_tac prg obls i tac =
   let obl = obls.(i) in
     match obl.obl_body with
-    | Some _ -> false
+    | Some _ -> None
     | None ->
 	try
 	  if List.is_empty (deps_remaining obls obl.obl_deps) then
@@ -927,30 +967,30 @@ and solve_obligation_by_tac prg obls i tac =
 		  | Some t -> t
 		  | None -> !default_tactic
 	    in
-	    let evd = Evd.from_ctx !prg.prg_ctx in
+	    let evd = Evd.from_ctx prg.prg_ctx in
 	    let evd = Evd.update_sigma_env evd (Global.env ()) in
-	    let t, ty, ctx = 
-	      solve_by_tac obl.obl_name (evar_of_obligation obl) tac 
-	        (pi2 !prg.prg_kind) (Evd.evar_universe_context evd)
+	    let t, ty, ctx =
+	      solve_by_tac obl.obl_name (evar_of_obligation obl) tac
+	        (pi2 prg.prg_kind) (Evd.evar_universe_context evd)
 	    in
 	    let uctx = Evd.evar_context_universe_context ctx in
-	    let () = prg := {!prg with prg_ctx = ctx} in
-	    let def, obl' = declare_obligation !prg obl t ty uctx in
+	    let prg = {prg with prg_ctx = ctx} in
+	    let def, obl' = declare_obligation prg obl t ty uctx in
 	      obls.(i) <- obl';
-	      if def && not (pi2 !prg.prg_kind) then (
+	      if def && not (pi2 prg.prg_kind) then (
 	        (* Declare the term constraints with the first obligation only *)
 	        let evd = Evd.from_env (Global.env ()) in
 	        let evd = Evd.merge_universe_subst evd (Evd.universe_subst (Evd.from_ctx ctx)) in
 		let ctx' = Evd.evar_universe_context evd in
-		  prg := {!prg with prg_ctx = ctx'});
-	      true
-	  else false
-	with e when Errors.noncritical e ->
-          let (e, _) = Errors.push e in
+		  Some {prg with prg_ctx = ctx'})
+	      else Some prg
+	  else None
+	with e when CErrors.noncritical e ->
+          let (e, _) = CErrors.push e in
           match e with
 	  | Refiner.FailError (_, s) ->
-	      user_err_loc (fst obl.obl_location, "solve_obligation", Lazy.force s)
-          | e -> false
+	      user_err ~loc:(fst obl.obl_location) ~hdr:"solve_obligation" (Lazy.force s)
+          | e -> None (* FIXME really ? *)
 
 and solve_prg_obligations prg ?oblset tac =
   let obls, rem = prg.prg_obligations in
@@ -962,16 +1002,20 @@ and solve_prg_obligations prg ?oblset tac =
     | Some s -> set := s;
       (fun i -> Int.Set.mem i !set)
   in
-  let prg = ref prg in
+  let prgref = ref prg in
   let _ =
     Array.iteri (fun i x ->
-      if p i && solve_obligation_by_tac prg obls' i tac then
- 	let deps = dependencies obls i in
- 	  (set := Int.Set.union !set deps;
- 	   decr rem))
+      if p i then
+        match solve_obligation_by_tac !prgref obls' i tac with
+	| None -> ()
+ 	| Some prg' ->
+	   prgref := prg';
+	   let deps = dependencies obls i in
+ 	   (set := Int.Set.union !set deps;
+ 	    decr rem))
       obls'
   in
-    update_obls !prg obls' !rem
+    update_obls !prgref obls' !rem
 
 and solve_obligations n tac =
   let prg = get_prog_err n in
@@ -984,9 +1028,9 @@ and try_solve_obligation n prg tac =
   let prg = get_prog prg in
   let obls, rem = prg.prg_obligations in
   let obls' = Array.copy obls in
-  let prgref = ref prg in
-    if solve_obligation_by_tac prgref obls' n tac then
-      ignore(update_obls !prgref obls' (pred rem));
+    match solve_obligation_by_tac prg obls' n tac with
+    | Some prg' -> ignore(update_obls prg' obls' (pred rem))
+    | None -> ()
 
 and try_solve_obligations n tac =
   try ignore (solve_obligations n tac) with NoObligations _ -> ()
@@ -1005,7 +1049,8 @@ let show_obligations_of_prg ?(msg=true) prg =
 		   match x.obl_body with
 		   | None ->
 		       if !showed > 0 then (
-			 decr showed;
+		         decr showed;
+			 let x = subst_deps_obl obls x in
 			 Feedback.msg_info (str "Obligation" ++ spc() ++ int (succ i) ++ spc () ++
 				   str "of" ++ spc() ++ Id.print n ++ str ":" ++ spc () ++
 				   hov 1 (Printer.pr_constr_env (Global.env ()) Evd.empty x.obl_type ++
diff --git a/toplevel/obligations.mli b/vernac/obligations.mli
index 3e99f5760..11366fe91 100644
--- a/toplevel/obligations.mli
+++ b/vernac/obligations.mli
@@ -24,6 +24,12 @@ val declare_definition_ref :
      Safe_typing.private_constants Entries.definition_entry -> Impargs.manual_implicits
        -> global_reference Lemmas.declaration_hook -> global_reference) ref
 
+(* This is a hack to make it possible for Obligations to craft a Qed
+ * behind the scenes.  The fix_exn the Stm attaches to the Future proof
+ * is not available here, so we provide a side channel to get it *)
+val stm_get_fix_exn : (unit -> Exninfo.iexn -> Exninfo.iexn) Hook.t
+
+
 val check_evars : env -> evar_map -> unit
 
 val evar_dependencies : evar_map -> Evar.t -> Evar.Set.t
@@ -33,7 +39,8 @@ val sort_dependencies : (Evar.t * evar_info * Evar.Set.t) list -> (Evar.t * evar
    evars contexts, object and type *)
 val eterm_obligations : env -> Id.t -> evar_map -> int ->
   ?status:Evar_kinds.obligation_definition_status -> constr -> types ->
-  (Id.t * types * Evar_kinds.t Loc.located * Evar_kinds.obligation_definition_status * Int.Set.t *
+  (Id.t * types * Evar_kinds.t Loc.located *
+     (bool * Evar_kinds.obligation_definition_status) * Int.Set.t *
       unit Proofview.tactic option) array
     (* Existential key, obl. name, type as product, 
        location of the original evar, associated tactic,
@@ -46,7 +53,7 @@ val eterm_obligations : env -> Id.t -> evar_map -> int ->
 
 type obligation_info =
   (Id.t * Term.types * Evar_kinds.t Loc.located *
-      Evar_kinds.obligation_definition_status * Int.Set.t * unit Proofview.tactic option) array
+      (bool * Evar_kinds.obligation_definition_status) * Int.Set.t * unit Proofview.tactic option) array
     (* ident, type, location, (opaque or transparent, expand or define),
        dependencies, tactic to solve it *)
 
@@ -57,9 +64,6 @@ type progress = (* Resolution status of a program *)
 
 val default_tactic : unit Proofview.tactic ref
 
-val set_proofs_transparency : bool -> unit (* true = All transparent, false = Opaque if possible *)
-val get_proofs_transparency : unit -> bool
-
 val add_definition : Names.Id.t -> ?term:Term.constr -> Term.types -> 
   Evd.evar_universe_context ->
   ?pl:(Id.t Loc.located list) -> (* Universe binders *)
@@ -89,9 +93,9 @@ val add_mutual_definitions :
   fixpoint_kind -> unit
 
 val obligation : int * Names.Id.t option * Constrexpr.constr_expr option ->
-  Tacexpr.raw_tactic_expr option -> unit
+  Genarg.glob_generic_argument option -> unit
 
-val next_obligation : Names.Id.t option -> Tacexpr.raw_tactic_expr option -> unit
+val next_obligation : Names.Id.t option -> Genarg.glob_generic_argument option -> unit
 
 val solve_obligations : Names.Id.t option -> unit Proofview.tactic option -> progress
 (* Number of remaining obligations to be solved for this program *)
diff --git a/toplevel/record.ml b/vernac/record.ml
index 0c3bd953c..d5faafaf8 100644
--- a/toplevel/record.ml
+++ b/vernac/record.ml
@@ -7,7 +7,7 @@
 (************************************************************************)
 
 open Pp
-open Errors
+open CErrors
 open Util
 open Names
 open Globnames
@@ -27,6 +27,8 @@ open Goptions
 open Sigma.Notations
 open Context.Rel.Declaration
 
+module RelDecl = Context.Rel.Declaration
+
 (********** definition d'un record (structure) **************)
 
 (** Flag governing use of primitive projections. Disabled by default. *)
@@ -82,7 +84,7 @@ let compute_constructor_level evars env l =
   List.fold_right (fun d (env, univ) ->
     let univ = 
       if is_local_assum d then
-	let s = Retyping.get_sort_of env evars (get_type d) in
+	let s = Retyping.get_sort_of env evars (RelDecl.get_type d) in
 	  Univ.sup (univ_of_sort s) univ 
       else univ
     in (push_rel d env, univ)) 
@@ -102,26 +104,32 @@ let typecheck_params_and_fields def id pl t ps nots fs =
     let error bk (loc, name) = 
       match bk, name with
       | Default _, Anonymous ->
-        user_err_loc (loc, "record", str "Record parameters must be named")
+        user_err ~loc ~hdr:"record" (str "Record parameters must be named")
       | _ -> ()
     in
       List.iter 
 	(function LocalRawDef (b, _) -> error default_binder_kind b
-	   | LocalRawAssum (ls, bk, ce) -> List.iter (error bk) ls) ps
+	   | LocalRawAssum (ls, bk, ce) -> List.iter (error bk) ls
+           | LocalPattern _ -> assert false) ps
   in 
   let impls_env, ((env1,newps), imps) = interp_context_evars env0 evars ps in
   let t', template = match t with 
     | Some t -> 
        let env = push_rel_context newps env0 in
+       let poly =
+         match t with
+         | CSort (_, Misctypes.GType []) -> true | _ -> false in
        let s = interp_type_evars env evars ~impls:empty_internalization_env t in
-       let sred = Reductionops.whd_betadeltaiota env !evars s in
+       let sred = Reductionops.whd_all env !evars s in
 	 (match kind_of_term sred with
 	 | Sort s' -> 
-	   (match Evd.is_sort_variable !evars s' with
-	   | Some l -> evars := Evd.make_flexible_variable !evars true l; 
-	     sred, true
-	   | None -> s, false)
-	 | _ -> user_err_loc (constr_loc t,"", str"Sort expected."))
+	    (if poly then
+               match Evd.is_sort_variable !evars s' with
+	       | Some l -> evars := Evd.make_flexible_variable !evars true l; 
+	                  sred, true
+	       | None -> s, false
+             else s, false)
+	 | _ -> user_err ~loc:(constr_loc t) (str"Sort expected."))
     | None -> 
       let uvarkind = Evd.univ_flexible_alg in
 	mkSort (Evarutil.evd_comb0 (Evd.new_sort_variable uvarkind) evars), true
@@ -161,7 +169,7 @@ let typecheck_params_and_fields def id pl t ps nots fs =
     Evd.universe_context ?names:pl evars, nf arity, template, imps, newps, impls, newfs
 
 let degenerate_decl decl =
-  let id = match get_name decl with
+  let id = match RelDecl.get_name decl with
     | Name id -> id
     | Anonymous -> anomaly (Pp.str "Unnamed record variable") in
   match decl with
@@ -172,6 +180,13 @@ type record_error =
   | MissingProj of Id.t * Id.t list
   | BadTypedProj of Id.t * env * Type_errors.type_error
 
+let warn_cannot_define_projection =
+  CWarnings.create ~name:"cannot-define-projection" ~category:"records"
+         (fun msg -> hov 0 msg)
+
+(* If a projection is not definable, we throw an error if the user
+asked it to be a coercion. Otherwise, we just print an info
+message. The user might still want to name the field of the record. *)
 let warning_or_error coe indsp err =
   let st = match err with
     | MissingProj (fi,projs) ->
@@ -195,8 +210,8 @@ let warning_or_error coe indsp err =
 	  | _ ->
               (pr_id fi ++ strbrk " cannot be defined because it is not typable.")
   in
-  if coe then errorlabstrm "structure" st;
-  Flags.if_verbose Feedback.msg_warning (hov 0 st)
+  if coe then user_err ~hdr:"structure" st;
+  Flags.if_verbose Feedback.msg_info (hov 0 st)
 
 type field_status =
   | NoProjection of Name.t
@@ -222,7 +237,7 @@ let subst_projection fid l c =
 	    | Projection t -> lift depth t
 	    | NoProjection (Name id) -> bad_projs := id :: !bad_projs; mkRel k
 	    | NoProjection Anonymous ->
-                errorlabstrm "" (str "Field " ++ pr_id fid ++
+                user_err  (str "Field " ++ pr_id fid ++
                   str " depends on the " ++ pr_nth (k-depth-1) ++ str
                   " field which has no name.")
         else
@@ -239,6 +254,12 @@ let instantiate_possibly_recursive_type indu paramdecls fields =
   let subst = List.map_i (fun i _ -> mkRel i) 1 paramdecls in
   Termops.substl_rel_context (subst@[mkIndU indu]) fields
 
+let warn_non_primitive_record =
+  CWarnings.create ~name:"non-primitive-record" ~category:"record"
+         (fun (env,indsp) ->
+          (hov 0 (str "The record " ++ Printer.pr_inductive env indsp ++ 
+                    strbrk" could not be defined as a primitive record")))
+
 (* We build projections *)
 let declare_projections indsp ?(kind=StructureComponent) binder_name coers fieldimpls fields =
   let env = Global.env() in
@@ -262,17 +283,15 @@ let declare_projections indsp ?(kind=StructureComponent) binder_name coers field
 	| Some None | None -> false
       in
 	if not is_primitive then 
-	  Flags.if_verbose Feedback.msg_warning
-	    (hov 0 (str "The record " ++ Printer.pr_inductive env indsp ++ 
-		      str" could not be defined as a primitive record"));
+	  warn_non_primitive_record (env,indsp);
 	is_primitive
     else false
   in
   let (_,_,kinds,sp_projs,_) =
     List.fold_left3
       (fun (nfi,i,kinds,sp_projs,subst) coe decl impls ->
-        let fi = get_name decl in
-        let ti = get_type decl in
+        let fi = RelDecl.get_name decl in
+        let ti = RelDecl.get_type decl in
 	let (sp_projs,i,subst) =
 	  match fi with
 	  | Anonymous ->
@@ -345,17 +364,17 @@ let structure_signature ctx =
       | [decl] ->
         let env = Environ.empty_named_context_val in
         let evm = Sigma.Unsafe.of_evar_map evm in
-        let Sigma (_, evm, _) = Evarutil.new_pure_evar env evm (get_type decl) in
+        let Sigma (_, evm, _) = Evarutil.new_pure_evar env evm (RelDecl.get_type decl) in
         let evm = Sigma.to_evar_map evm in
         evm
       | decl::tl ->
           let env = Environ.empty_named_context_val in
           let evm = Sigma.Unsafe.of_evar_map evm in
-          let Sigma (ev, evm, _) = Evarutil.new_pure_evar env evm (get_type decl) in
+          let Sigma (ev, evm, _) = Evarutil.new_pure_evar env evm (RelDecl.get_type decl) in
           let evm = Sigma.to_evar_map evm in
 	  let new_tl = Util.List.map_i
 	    (fun pos decl ->
-	       map_type (fun t -> Termops.replace_term (mkRel pos) (mkEvar(ev,[||])) t) decl) 1 tl in
+	       RelDecl.map_type (fun t -> Termops.replace_term (mkRel pos) (mkEvar(ev,[||])) t) decl) 1 tl in
 	  deps_to_evar evm new_tl in
   deps_to_evar Evd.empty (List.rev ctx)
 
@@ -386,7 +405,9 @@ let declare_structure finite poly ctx id idbuild paramimpls params arity templat
       mind_entry_inds = [mie_ind];
       mind_entry_polymorphic = poly;
       mind_entry_private = None;
-      mind_entry_universes = ctx } in
+      mind_entry_universes = ctx;
+    }
+  in
   let kn = Command.declare_mutual_inductive_with_eliminations mie [] [(paramimpls,[])] in
   let rsp = (kn,0) in (* This is ind path of idstruc *)
   let cstr = (rsp,1) in
@@ -403,7 +424,7 @@ let implicits_of_context ctx =
       | Name n -> Some n
       | Anonymous -> None
     in ExplByPos (i, explname), (true, true, true))
-    1 (List.rev (Anonymous :: (List.map get_name ctx)))
+    1 (List.rev (Anonymous :: (List.map RelDecl.get_name ctx)))
 
 let declare_class finite def poly ctx id idbuild paramimpls params arity 
     template fieldimpls fields ?(kind=StructureComponent) is_coe coers priorities sign =
@@ -457,13 +478,13 @@ let declare_class finite def poly ctx id idbuild paramimpls params arity
 			      if b then Backward, pri else Forward, pri) coe)
 	  coers priorities
        in
-       let l = List.map3 (fun decl b y -> get_name decl, b, y)
+       let l = List.map3 (fun decl b y -> RelDecl.get_name decl, b, y)
          (List.rev fields) coers (Recordops.lookup_projections ind)
        in IndRef ind, l
   in
   let ctx_context =
     List.map (fun decl ->
-      match Typeclasses.class_of_constr (get_type decl) with
+      match Typeclasses.class_of_constr (RelDecl.get_type decl) with
       | Some (_, ((cl,_), _)) -> Some (cl.cl_impl, true)
       | None -> None)
       params, params
@@ -498,15 +519,9 @@ let add_inductive_class ind =
   let k =
     let ctx = oneind.mind_arity_ctxt in
     let inst = Univ.UContext.instance mind.mind_universes in
-    let map = function
-    | LocalDef _ -> None
-    | LocalAssum (_, t) -> Some (lazy t)
-    in
-    let args = List.map_filter map ctx in
-    let ty = Inductive.type_of_inductive_knowing_parameters
+    let ty = Inductive.type_of_inductive
       (push_rel_context ctx (Global.env ()))
       ((mind,oneind),inst)
-      (Array.of_list args)
     in
       { cl_impl = IndRef ind;
 	cl_context = List.map (const None) ctx, ctx;
@@ -520,14 +535,14 @@ let declare_existing_class g =
   match g with
   | ConstRef x -> add_constant_class x
   | IndRef x -> add_inductive_class x
-  | _ -> user_err_loc (Loc.dummy_loc, "declare_existing_class", 
-		      Pp.str"Unsupported class type, only constants and inductives are allowed")
+  | _ -> user_err ~hdr:"declare_existing_class"
+		      (Pp.str"Unsupported class type, only constants and inductives are allowed")
 
 open Vernacexpr
 
 (* [fs] corresponds to fields and [ps] to parameters; [coers] is a
    list telling if the corresponding fields must me declared as coercions 
-   or subinstances *)
+   or subinstances. *)
 let definition_structure (kind,poly,finite,(is_coe,((loc,idstruc),pl)),ps,cfs,idbuild,s) =
   let cfs,notations = List.split cfs in
   let cfs,priorities = List.split cfs in
@@ -537,8 +552,10 @@ let definition_structure (kind,poly,finite,(is_coe,((loc,idstruc),pl)),ps,cfs,id
     | Vernacexpr.DefExpr ((_,Name id),_,_) -> id::acc
     | _ -> acc in
   let allnames =  idstruc::(List.fold_left extract_name [] fs) in
-  if not (List.distinct_f Id.compare allnames)
-  then error "Two objects have the same name";
+  let () = match List.duplicates Id.equal allnames with
+  | [] -> ()
+  | id :: _ -> user_err (str "Two objects have the same name" ++ spc () ++ quote (Id.print id))
+  in
   let isnot_class = match kind with Class false -> false | _ -> true in
   if isnot_class && List.exists (fun opt -> not (Option.is_empty opt)) priorities then
     error "Priorities only allowed for type class substructures";
@@ -548,15 +565,16 @@ let definition_structure (kind,poly,finite,(is_coe,((loc,idstruc),pl)),ps,cfs,id
       typecheck_params_and_fields (kind = Class true) idstruc pl s ps notations fs) () in
   let sign = structure_signature (fields@params) in
   let gr = match kind with
-    | Class def ->
-	let gr = declare_class finite def poly ctx (loc,idstruc) idbuild
+  | Class def ->
+     let priorities = List.map (fun id -> {hint_priority = id; hint_pattern = None}) priorities in
+     let gr = declare_class finite def poly ctx (loc,idstruc) idbuild
 	  implpars params arity template implfs fields is_coe coers priorities sign in
 	gr
     | _ ->
 	let implfs = List.map
 	  (fun impls -> implpars @ Impargs.lift_implicits
 	    (succ (List.length params)) impls) implfs in
-	let ind = declare_structure finite poly ctx idstruc 
+	let ind = declare_structure finite poly ctx idstruc
 	  idbuild implpars params arity template implfs 
 	  fields is_coe (List.map (fun coe -> not (Option.is_empty coe)) coers) sign in
 	IndRef ind
diff --git a/toplevel/record.mli b/vernac/record.mli
index 26eb3378b..c50e57786 100644
--- a/toplevel/record.mli
+++ b/vernac/record.mli
@@ -24,7 +24,8 @@ val declare_projections :
   coercion_flag list -> manual_explicitation list list -> Context.Rel.t ->
   (Name.t * bool) list * constant option list
 
-val declare_structure : Decl_kinds.recursivity_kind ->
+val declare_structure :
+  Decl_kinds.recursivity_kind ->
   bool (** polymorphic?*) -> Univ.universe_context ->
   Id.t -> Id.t ->
   manual_explicitation list -> Context.Rel.t -> (** params *) constr -> (** arity *)
@@ -37,7 +38,8 @@ val declare_structure : Decl_kinds.recursivity_kind ->
   inductive
 
 val definition_structure :
-  inductive_kind * Decl_kinds.polymorphic * Decl_kinds.recursivity_kind * plident with_coercion * local_binder list *
+  inductive_kind * Decl_kinds.polymorphic * Decl_kinds.recursivity_kind *
+  plident with_coercion * local_binder list *
   (local_decl_expr with_instance with_priority with_notation) list *
   Id.t * constr_expr option -> global_reference
 
diff --git a/toplevel/search.ml b/vernac/search.ml
index 646e2e08a..e1b56b131 100644
--- a/toplevel/search.ml
+++ b/vernac/search.ml
@@ -20,6 +20,8 @@ open Globnames
 open Nametab
 open Goptions
 
+module NamedDecl = Context.Named.Declaration
+
 type filter_function = global_reference -> env -> constr -> bool
 type display_function = global_reference -> env -> constr -> unit
 
@@ -29,17 +31,6 @@ query, separated by a newline. This type of output is useful for
 editors (like emacs), to generate a list of completion candidates
 without having to parse thorugh the types of all symbols. *)
 
-let search_output_name_only = ref false
-
-let _ =
-  declare_bool_option
-    { optsync  = true;
-      optdepr  = false;
-      optname  = "output-name-only search";
-      optkey   = ["Search";"Output";"Name";"Only"];
-      optread  = (fun () -> !search_output_name_only);
-      optwrite = (:=) search_output_name_only }
-
 type glob_search_about_item =
   | GlobSearchSubPattern of constr_pattern
   | GlobSearchString of string
@@ -68,8 +59,7 @@ let iter_constructors indsp u fn env nconstr =
   done
 
 let iter_named_context_name_type f =
-  let open Context.Named.Declaration in
-  List.iter (fun decl -> f (get_id decl) (get_type decl))
+  List.iter (fun decl -> f (NamedDecl.get_id decl) (NamedDecl.get_type decl))
 
 (* General search over hypothesis of a goal *)
 let iter_hypothesis glnum (fn : global_reference -> env -> constr -> unit) =
@@ -81,13 +71,12 @@ let iter_hypothesis glnum (fn : global_reference -> env -> constr -> unit) =
 
 (* General search over declarations *)
 let iter_declarations (fn : global_reference -> env -> constr -> unit) =
-  let open Context.Named.Declaration in
   let env = Global.env () in
   let iter_obj (sp, kn) lobj = match object_tag lobj with
   | "VARIABLE" ->
     begin try
       let decl = Global.lookup_named (basename sp) in
-      fn (VarRef (get_id decl)) env (get_type decl)
+      fn (VarRef (NamedDecl.get_id decl)) env (NamedDecl.get_type decl)
     with Not_found -> (* we are in a section *) () end
   | "CONSTANT" ->
     let cst = Global.constant_of_delta_kn kn in
@@ -118,24 +107,78 @@ let generic_search glnumopt fn =
   | Some glnum ->  iter_hypothesis glnum fn);
   iter_declarations fn
 
-(** Standard display *)
-let plain_display accu ref env c =
-  let pr = pr_global ref in
-  if !search_output_name_only then
-    accu := pr :: !accu
-  else begin
-    let pc = pr_lconstr_env env Evd.empty c in
-    accu := hov 2 (pr ++ str":" ++ spc () ++ pc) :: !accu
-  end
+(** This module defines a preference on constrs in the form of a
+    [compare] function (preferred constr must be big for this
+    functions, so preferences such as small constr must use a reversed
+    order). This priority will be used to order search results and
+    propose first results which are more likely to be relevant to the
+    query, this is why the type [t] contains the other elements
+    required of a search. *)
+module ConstrPriority = struct
+
+  (* The priority is memoised here. Because of the very localised use
+     of this module, it is not worth it making a convenient interface. *)
+  type t =
+    Globnames.global_reference * Environ.env * Constr.t * priority
+  and priority = int
+
+  module ConstrSet = CSet.Make(Constr)
+
+  (** A measure of the size of a term *)
+  let rec size t =
+    Constr.fold (fun s t -> 1 + s + size t) 0 t
+
+  (** Set of the "symbols" (definitions, inductives, constructors)
+      which appear in a term. *)
+  let rec symbols acc t =
+    let open Constr in
+    match kind t with
+    | Const _ | Ind _ | Construct _ -> ConstrSet.add t acc
+    | _ -> Constr.fold symbols acc t
+
+  (** The number of distinct "symbols" (see {!symbols}) which appear
+      in a term. *)
+  let num_symbols t =
+    ConstrSet.(cardinal (symbols empty t))
+
+  let priority t : priority =
+    -(3*(num_symbols t) + size t)
+
+  let compare (_,_,_,p1) (_,_,_,p2) =
+    compare p1 p2
+end
+
+module PriorityQueue = Heap.Functional(ConstrPriority)
+
+let rec iter_priority_queue q fn =
+  (* use an option to make the function tail recursive. Will be
+     obsoleted with Ocaml 4.02 with the [match … with | exception …]
+     syntax. *)
+  let next = begin
+      try Some (PriorityQueue.maximum q)
+      with Heap.EmptyHeap -> None
+  end in
+  match next with
+  | Some (gref,env,t,_) ->
+    fn gref env t;
+    iter_priority_queue (PriorityQueue.remove q) fn
+  | None -> ()
 
-let format_display l = prlist_with_sep fnl (fun x -> x) (List.rev l)
+let prioritize_search seq fn =
+  let acc = ref PriorityQueue.empty in
+  let iter gref env t =
+    let p = ConstrPriority.priority t in
+    acc := PriorityQueue.add (gref,env,t,p) !acc
+  in
+  let () = seq iter in
+  iter_priority_queue !acc fn
 
 (** Filters *)
 
 (** This function tries to see whether the conclusion matches a pattern. *)
 (** FIXME: this is quite dummy, we may find a more efficient algorithm. *)
 let rec pattern_filter pat ref env typ =
-  let typ = strip_outer_cast typ in
+  let typ = Termops.strip_outer_cast typ in
   if Constr_matching.is_matching env Evd.empty pat typ then true
   else match kind_of_term typ with
   | Prod (_, _, typ)
@@ -143,7 +186,7 @@ let rec pattern_filter pat ref env typ =
   | _ -> false
 
 let rec head_filter pat ref env typ =
-  let typ = strip_outer_cast typ in
+  let typ = Termops.strip_outer_cast typ in
   if Constr_matching.is_matching_head env Evd.empty pat typ then true
   else match kind_of_term typ with
   | Prod (_, _, typ)
@@ -155,8 +198,9 @@ let full_name_of_reference ref =
   DirPath.to_string dir ^ "." ^ Id.to_string id
 
 (** Whether a reference is blacklisted *)
-let blacklist_filter ref env typ =
+let blacklist_filter_aux () =
   let l = SearchBlacklist.elements () in
+  fun ref env typ ->
   let name = full_name_of_reference ref in
   let is_not_bl str = not (String.string_contains ~where:name ~what:str) in
   List.for_all is_not_bl l
@@ -180,19 +224,17 @@ let search_about_filter query gr env typ = match query with
 
 (** SearchPattern *)
 
-let search_pattern gopt pat mods =
-  let ans = ref [] in
+let search_pattern gopt pat mods pr_search =
+  let blacklist_filter = blacklist_filter_aux () in
   let filter ref env typ =
-    let f_module = module_filter mods ref env typ in
-    let f_blacklist = blacklist_filter ref env typ in
-    let f_pattern () = pattern_filter pat ref env typ in
-    f_module && f_pattern () && f_blacklist
+    module_filter mods ref env typ &&
+    pattern_filter pat ref env typ &&
+    blacklist_filter ref env typ
   in
   let iter ref env typ =
-    if filter ref env typ then plain_display ans ref env typ
+    if filter ref env typ then pr_search ref env typ
   in
-  let () = generic_search gopt iter in
-  format_display !ans
+  generic_search gopt iter
 
 (** SearchRewrite *)
 
@@ -204,63 +246,56 @@ let rewrite_pat1 pat =
 let rewrite_pat2 pat =
   PApp (PRef eq, [| PMeta None; PMeta None; pat |])
 
-let search_rewrite gopt pat mods =
+let search_rewrite gopt pat mods pr_search =
   let pat1 = rewrite_pat1 pat in
   let pat2 = rewrite_pat2 pat in
-  let ans = ref [] in
+  let blacklist_filter = blacklist_filter_aux () in
   let filter ref env typ =
-    let f_module = module_filter mods ref env typ in
-    let f_blacklist = blacklist_filter ref env typ in
-    let f_pattern () =
-      pattern_filter pat1 ref env typ ||
-      pattern_filter pat2 ref env typ
-    in
-    f_module && f_pattern () && f_blacklist
+    module_filter mods ref env typ &&
+    (pattern_filter pat1 ref env typ ||
+       pattern_filter pat2 ref env typ) &&
+    blacklist_filter ref env typ
   in
   let iter ref env typ =
-    if filter ref env typ then plain_display ans ref env typ
+    if filter ref env typ then pr_search ref env typ
   in
-  let () = generic_search gopt iter in
-  format_display !ans
+  generic_search gopt iter
 
 (** Search *)
 
-let search_by_head gopt pat mods =
-  let ans = ref [] in
+let search_by_head gopt pat mods pr_search =
+  let blacklist_filter = blacklist_filter_aux () in
   let filter ref env typ =
-    let f_module = module_filter mods ref env typ in
-    let f_blacklist = blacklist_filter ref env typ in
-    let f_pattern () = head_filter pat ref env typ in
-    f_module && f_pattern () && f_blacklist
+    module_filter mods ref env typ &&
+    head_filter pat ref env typ &&
+    blacklist_filter ref env typ
   in
   let iter ref env typ =
-    if filter ref env typ then plain_display ans ref env typ
+    if filter ref env typ then pr_search ref env typ
   in
-  let () = generic_search gopt iter in
-  format_display !ans
+  generic_search gopt iter
 
 (** SearchAbout *)
 
-let search_about gopt items mods =
-  let ans = ref [] in
+let search_about gopt items mods pr_search =
+  let blacklist_filter = blacklist_filter_aux () in
   let filter ref env typ =
     let eqb b1 b2 = if b1 then b2 else not b2 in
-    let f_module = module_filter mods ref env typ in
-    let f_about (b, i) = eqb b (search_about_filter i ref env typ) in
-    let f_blacklist = blacklist_filter ref env typ in
-    f_module && List.for_all f_about items && f_blacklist
+    module_filter mods ref env typ &&
+    List.for_all
+      (fun (b,i) -> eqb b (search_about_filter i ref env typ)) items &&
+    blacklist_filter ref env typ
   in
   let iter ref env typ =
-    if filter ref env typ then plain_display ans ref env typ
+    if filter ref env typ then pr_search ref env typ
   in
-  let () = generic_search gopt iter in
-  format_display !ans
+  generic_search gopt iter
 
 type search_constraint =
-  | Name_Pattern of string
-  | Type_Pattern of string
-  | SubType_Pattern of string
-  | In_Module of string list
+  | Name_Pattern of Str.regexp
+  | Type_Pattern of Pattern.constr_pattern
+  | SubType_Pattern of Pattern.constr_pattern
+  | In_Module of Names.DirPath.t
   | Include_Blacklist
 
 type 'a coq_object = {
@@ -269,43 +304,25 @@ type 'a coq_object = {
   coq_object_object : 'a;
 }
 
-let interface_search flags =
-  let env = Global.env () in
+let interface_search =
   let rec extract_flags name tpe subtpe mods blacklist = function
   | [] -> (name, tpe, subtpe, mods, blacklist)
-  | (Name_Pattern s, b) :: l ->
-    let regexp =
-      try Str.regexp s
-      with e when Errors.noncritical e ->
-        Errors.errorlabstrm "Search.interface_search"
-          (str "Invalid regexp: " ++ str s)
-    in
+  | (Name_Pattern regexp, b) :: l ->
     extract_flags ((regexp, b) :: name) tpe subtpe mods blacklist l
-  | (Type_Pattern s, b) :: l ->
-    let constr = Pcoq.parse_string Pcoq.Constr.lconstr_pattern s in
-    let (_, pat) = Constrintern.intern_constr_pattern env constr in
+  | (Type_Pattern pat, b) :: l ->
     extract_flags name ((pat, b) :: tpe) subtpe mods blacklist l
-  | (SubType_Pattern s, b) :: l ->
-    let constr = Pcoq.parse_string Pcoq.Constr.lconstr_pattern s in
-    let (_, pat) = Constrintern.intern_constr_pattern env constr in
+  | (SubType_Pattern pat, b) :: l ->
     extract_flags name tpe ((pat, b) :: subtpe) mods blacklist l
-  | (In_Module m, b) :: l ->
-    let path = String.concat "." m in
-    let m = Pcoq.parse_string Pcoq.Constr.global path in
-    let (_, qid) = Libnames.qualid_of_reference m in
-    let id =
-      try Nametab.full_name_module qid
-      with Not_found ->
-        Errors.errorlabstrm "Search.interface_search"
-          (str "Module " ++ str path ++ str " not found.")
-    in
+  | (In_Module id, b) :: l ->
     extract_flags name tpe subtpe ((id, b) :: mods) blacklist l
   | (Include_Blacklist, b) :: l ->
     extract_flags name tpe subtpe mods b l
   in
+  fun ?glnum flags ->
   let (name, tpe, subtpe, mods, blacklist) =
     extract_flags [] [] [] [] false flags
   in
+  let blacklist_filter = blacklist_filter_aux () in
   let filter_function ref env constr =
     let id = Names.Id.to_string (Nametab.basename_of_global ref) in
     let path = Libnames.dirpath (Nametab.path_of_global ref) in
@@ -324,13 +341,11 @@ let interface_search flags =
     let match_module (mdl, flag) =
       toggle (Libnames.is_dirpath_prefix_of mdl path) flag
     in
-    let in_blacklist =
-      blacklist || (blacklist_filter ref env constr)
-    in
     List.for_all match_name name &&
     List.for_all match_type tpe &&
     List.for_all match_subtype subtpe &&
-    List.for_all match_module mods && in_blacklist
+    List.for_all match_module mods &&
+    (blacklist || blacklist_filter ref env constr)
   in
   let ans = ref [] in
   let print_function ref env constr =
@@ -359,5 +374,8 @@ let interface_search flags =
   let iter ref env typ =
     if filter_function ref env typ then print_function ref env typ
   in
-  let () = generic_search None iter in (* TODO: chose a goal number? *)
+  let () = generic_search glnum iter in
   !ans
+
+let blacklist_filter ref env typ =
+  blacklist_filter_aux () ref env typ
diff --git a/toplevel/search.mli b/vernac/search.mli
index 78b0c45c0..c9167c485 100644
--- a/toplevel/search.mli
+++ b/vernac/search.mli
@@ -39,21 +39,24 @@ val search_about_filter : glob_search_about_item -> filter_function
 goal and the global environment for things matching [pattern] and
 satisfying module exclude/include clauses of [modinout]. *)
 
-val search_by_head : int option -> constr_pattern -> DirPath.t list * bool -> std_ppcmds
-val search_rewrite : int option -> constr_pattern -> DirPath.t list * bool -> std_ppcmds
-val search_pattern : int option -> constr_pattern -> DirPath.t list * bool -> std_ppcmds
+val search_by_head : int option -> constr_pattern -> DirPath.t list * bool
+                  -> display_function -> unit
+val search_rewrite : int option -> constr_pattern -> DirPath.t list * bool
+                  -> display_function -> unit
+val search_pattern : int option -> constr_pattern -> DirPath.t list * bool
+                  -> display_function -> unit
 val search_about   : int option -> (bool * glob_search_about_item) list
-  -> DirPath.t list * bool -> std_ppcmds
+                  -> DirPath.t list * bool -> display_function -> unit
 
 type search_constraint =
   (** Whether the name satisfies a regexp (uses Ocaml Str syntax) *)
-  | Name_Pattern of string
+  | Name_Pattern of Str.regexp
   (** Whether the object type satisfies a pattern *)
-  | Type_Pattern of string
+  | Type_Pattern of Pattern.constr_pattern
   (** Whether some subtype of object type satisfies a pattern *)
-  | SubType_Pattern of string
+  | SubType_Pattern of Pattern.constr_pattern
   (** Whether the object pertains to a module *)
-  | In_Module of string list
+  | In_Module of Names.DirPath.t
   (** Bypass the Search blacklist *)
   | Include_Blacklist
 
@@ -63,7 +66,7 @@ type 'a coq_object = {
   coq_object_object : 'a;
 }
 
-val interface_search : (search_constraint * bool) list ->
+val interface_search : ?glnum:int -> (search_constraint * bool) list ->
   string coq_object list
 
 (** {6 Generic search function} *)
@@ -71,3 +74,11 @@ val interface_search : (search_constraint * bool) list ->
 val generic_search : int option -> display_function -> unit
 (** This function iterates over all hypothesis of the goal numbered
     [glnum] (if present) and all known declarations. *)
+
+(** {6 Search function modifiers} *)
+
+val prioritize_search : (display_function -> unit) -> display_function -> unit
+(** [prioritize_search iter] iterates over the values of [iter] (seen
+    as a sequence of declarations), in a relevance order. This requires to
+    perform the entire iteration of [iter] before starting streaming. So
+    [prioritize_search] should not be used for low-latency streaming. *)
diff --git a/vernac/vernac.mllib b/vernac/vernac.mllib
new file mode 100644
index 000000000..94ef54f70
--- /dev/null
+++ b/vernac/vernac.mllib
@@ -0,0 +1,17 @@
+Lemmas
+Himsg
+ExplainErr
+Class
+Locality
+Metasyntax
+Auto_ind_decl
+Search
+Indschemes
+Obligations
+Command
+Classes
+Record
+Assumptions
+Vernacinterp
+Mltop
+Vernacentries
diff --git a/toplevel/vernacentries.ml b/vernac/vernacentries.ml
index 65d71c8d5..8b7d65457 100644
--- a/toplevel/vernacentries.ml
+++ b/vernac/vernacentries.ml
@@ -9,7 +9,7 @@
 (* Concrete syntax of the mathematical vernacular MV V2.6 *)
 
 open Pp
-open Errors
+open CErrors
 open Util
 open Flags
 open Names
@@ -33,6 +33,8 @@ open Misctypes
 open Locality
 open Sigma.Notations
 
+module NamedDecl = Context.Named.Declaration
+
 (** TODO: make this function independent of Ltac *)
 let (f_interp_redexp, interp_redexp_hook) = Hook.make ()
 
@@ -105,7 +107,7 @@ let show_intro all =
   let {Evd.it=gls ; sigma=sigma; } = Proof.V82.subgoals pf in
   if not (List.is_empty gls) then begin
     let gl = {Evd.it=List.hd gls ; sigma = sigma; } in
-    let l,_= decompose_prod_assum (strip_outer_cast (pf_concl gl)) in
+    let l,_= decompose_prod_assum (Termops.strip_outer_cast (pf_concl gl)) in
     if all then
       let lid = Tactics.find_intro_names l gl in
       Feedback.msg_notice (hov 0 (prlist_with_sep  spc pr_id lid))
@@ -120,9 +122,7 @@ let show_intro all =
     [Not_found] is raised if the given string isn't the qualid of
     a known inductive type. *)
 
-let make_cases s =
-  let qualified_name = Libnames.qualid_of_string s in
-  let glob_ref = Nametab.locate qualified_name in
+let make_cases_aux glob_ref =
   match glob_ref with
     | Globnames.IndRef i ->
 	let {Declarations.mind_nparams = np}
@@ -135,18 +135,23 @@ let make_cases s =
 	     let rec rename avoid = function
 	       | [] -> []
 	       | (n,_)::l ->
-		   let n' = Namegen.next_name_away_in_cases_pattern ([],mkMeta 0) n avoid in
+		   let n' = Namegen.next_name_away_with_default (Id.to_string Namegen.default_dependent_ident) n avoid in
 		   Id.to_string n' :: rename (n'::avoid) l in
 	     let al' = rename [] al in
 	     (Id.to_string consname :: al') :: l)
 	  carr tarr []
     | _ -> raise Not_found
 
+let make_cases s =
+  let qualified_name = Libnames.qualid_of_string s in
+  let glob_ref = Nametab.locate qualified_name in
+  make_cases_aux glob_ref
+
 (** Textual display of a generic "match" template *)
 
 let show_match id =
   let patterns =
-    try make_cases (Id.to_string (snd id))
+    try make_cases_aux (Nametab.global id)
     with Not_found -> error "Unknown inductive type."
   in
   let pr_branch l =
@@ -352,7 +357,7 @@ let dump_universes_gen g s =
     close ();
     Feedback.msg_info (str "Universes written to file \"" ++ str s ++ str "\".")
   with reraise ->
-    let reraise = Errors.push reraise in
+    let reraise = CErrors.push reraise in
     close ();
     iraise reraise
 
@@ -379,9 +384,9 @@ let err_unmapped_library loc ?from qid =
   | Some from ->
     str " and prefix " ++ pr_dirpath from ++ str "."
   in
-  user_err_loc
-    (loc,"locate_library",
-     strbrk "Cannot find a physical path bound to logical path matching suffix " ++
+  user_err ~loc
+    ~hdr:"locate_library"
+    (strbrk "Cannot find a physical path bound to logical path matching suffix " ++
        pr_dirpath dir ++ prefix)
 
 let err_notfound_library loc ?from qid =
@@ -390,9 +395,8 @@ let err_notfound_library loc ?from qid =
   | Some from ->
     str " with prefix " ++ pr_dirpath from ++ str "."
   in
-  user_err_loc
-    (loc,"locate_library",
-     strbrk "Unable to locate library " ++ pr_qualid qid ++ prefix)
+  user_err ~loc ~hdr:"locate_library"
+     (strbrk "Unable to locate library " ++ pr_qualid qid ++ prefix)
 
 let print_located_library r =
   let (loc,qid) = qualid_of_reference r in
@@ -403,14 +407,14 @@ let print_located_library r =
 
 let smart_global r =
   let gr = Smartlocate.smart_global r in
-    Dumpglob.add_glob (Constrarg.loc_of_or_by_notation loc_of_reference r) gr;
+    Dumpglob.add_glob (Stdarg.loc_of_or_by_notation loc_of_reference r) gr;
     gr
 
 let dump_global r =
   try
     let gr = Smartlocate.smart_global r in
-    Dumpglob.add_glob (Constrarg.loc_of_or_by_notation loc_of_reference r) gr
-  with e when Errors.noncritical e -> ()
+    Dumpglob.add_glob (Stdarg.loc_of_or_by_notation loc_of_reference r) gr
+  with e when CErrors.noncritical e -> ()
 (**********)
 (* Syntax *)
 
@@ -444,7 +448,27 @@ let vernac_notation locality local =
 (***********)
 (* Gallina *)
 
-let start_proof_and_print k l hook = start_proof_com k l hook
+let start_proof_and_print k l hook =
+  let inference_hook =
+    if Flags.is_program_mode () then
+      let hook env sigma ev =
+        let tac = !Obligations.default_tactic in
+        let evi = Evd.find sigma ev in
+        let env = Evd.evar_filtered_env evi in
+        try
+          let concl = Evarutil.nf_evars_universes sigma evi.Evd.evar_concl in
+          if Evarutil.has_undefined_evars sigma concl then raise Exit;
+          let c, _, ctx =
+            Pfedit.build_by_tactic env (Evd.evar_universe_context sigma)
+                                   concl (Tacticals.New.tclCOMPLETE tac)
+          in Evd.set_universe_context sigma ctx, c
+        with Logic_monad.TacticFailure e when Logic.catchable_exception e ->
+          error "The statement obligations could not be resolved \
+                 automatically, write a statement definition first."
+      in Some hook
+    else None
+  in
+  start_proof_com ?inference_hook k l hook
 
 let no_hook = Lemmas.mk_hook (fun _ _ -> ())
 
@@ -483,18 +507,15 @@ let vernac_start_proof locality p kind l lettop =
 	| None -> ()) l;
   if not(refining ()) then
     if lettop then
-      errorlabstrm "Vernacentries.StartProof"
+      user_err ~hdr:"Vernacentries.StartProof"
 	(str "Let declarations can only be used in proof editing mode.");
   start_proof_and_print (local, p, Proof kind) l no_hook
 
 let qed_display_script = ref true
 
 let vernac_end_proof ?proof = function
-  | Admitted -> save_proof ?proof Admitted
-  | Proved (_,_) as e ->
-    if is_verbose () && !qed_display_script && !Flags.coqtop_ui then
-      Stm.show_script ?proof ();
-    save_proof ?proof e
+  | Admitted          -> save_proof ?proof Admitted
+  | Proved (_,_) as e -> save_proof ?proof e
 
   (* A stupid macro that should be replaced by ``Exact c. Save.'' all along
      the theories [??] *)
@@ -531,6 +552,10 @@ let vernac_record k poly finite struc binders sort nameopt cfs =
 	| _ -> ()) cfs);
     ignore(Record.definition_structure (k,poly,finite,struc,binders,cfs,const,sort))
 
+(** When [poly] is true the type is declared polymorphic. When [lo] is true,
+    then the type is declared private (as per the [Private] keyword). [finite]
+    indicates whether the type is inductive, co-inductive or
+    neither. *)
 let vernac_inductive poly lo finite indl =
   if Dumpglob.dump () then
     List.iter (fun (((coe,(lid,_)), _, _, _, cstrs), _) ->
@@ -542,30 +567,30 @@ let vernac_inductive poly lo finite indl =
 	| _ -> () (* dumping is done by vernac_record (called below) *) )
       indl;
   match indl with
-  | [ ( _ , _ , _ ,Record, Constructors _ ),_ ] ->
-      Errors.error "The Record keyword cannot be used to define a variant type. Use Variant instead."
+  | [ ( _ , _ , _ ,(Record|Structure), Constructors _ ),_ ] ->
+      CErrors.error "The Record keyword is for types defined using the syntax { ... }."
   | [ (_ , _ , _ ,Variant, RecordDecl _),_ ] ->
-      Errors.error "The Variant keyword cannot be used to define a record type. Use Record instead."
+      CErrors.error "The Variant keyword does not support syntax { ... }."
   | [ ( id , bl , c , b, RecordDecl (oc,fs) ), [] ] ->
-      vernac_record (match b with Class true -> Class false | _ -> b)
+      vernac_record (match b with Class _ -> Class false | _ -> b)
        poly finite id bl c oc fs
-  | [ ( id , bl , c , Class true, Constructors [l]), _ ] ->
+  | [ ( id , bl , c , Class _, Constructors [l]), [] ] ->
       let f =
 	let (coe, ((loc, id), ce)) = l in
 	let coe' = if coe then Some true else None in
   	  (((coe', AssumExpr ((loc, Name id), ce)), None), [])
       in vernac_record (Class true) poly finite id bl c None [f]
-  | [ ( id , bl , c , Class true, _), _ ] ->
-      Errors.error "Definitional classes must have a single method"
-  | [ ( id , bl , c , Class false, Constructors _), _ ] ->
-      Errors.error "Inductive classes not supported"
+  | [ ( _ , _, _, Class _, Constructors _), [] ] ->
+      CErrors.error "Inductive classes not supported"
+  | [ ( id , bl , c , Class _, _), _ :: _ ] ->
+      CErrors.error "where clause not supported for classes"
   | [ ( _ , _ , _ , _, RecordDecl _ ) , _ ] ->
-      Errors.error "where clause not supported for (co)inductive records"
+      CErrors.error "where clause not supported for (co)inductive records"
   | _ -> let unpack = function
       | ( (false, id) , bl , c , _ , Constructors l ) , ntn  -> ( id , bl , c , l ) , ntn
       | ( (true,_),_,_,_,Constructors _),_ ->
-          Errors.error "Variant types do not handle the \"> Name\" syntax, which is reserved for records. Use the \":>\" syntax on constructors instead."
-      | _ -> Errors.error "Cannot handle mutually (co)inductive records."
+          CErrors.error "Variant types do not handle the \"> Name\" syntax, which is reserved for records. Use the \":>\" syntax on constructors instead."
+      | _ -> CErrors.error "Cannot handle mutually (co)inductive records."
     in
     let indl = List.map unpack indl in
     do_mutual_inductive indl poly lo finite
@@ -600,15 +625,15 @@ let vernac_combined_scheme lid l =
 
 let vernac_universe loc poly l =
   if poly && not (Lib.sections_are_opened ()) then
-    user_err_loc (loc, "vernac_universe",
-		  str"Polymorphic universes can only be declared inside sections, " ++
+    user_err ~loc ~hdr:"vernac_universe"
+		 (str"Polymorphic universes can only be declared inside sections, " ++
 		  str "use Monomorphic Universe instead");
   do_universe poly l
 
 let vernac_constraint loc poly l =
   if poly && not (Lib.sections_are_opened ()) then
-    user_err_loc (loc, "vernac_constraint",
-		  str"Polymorphic universe constraints can only be declared"
+    user_err ~loc ~hdr:"vernac_constraint"
+		 (str"Polymorphic universe constraints can only be declared"
 		  ++ str " inside sections, use Monomorphic Constraint instead");
   do_constraint poly l
 
@@ -813,9 +838,9 @@ let vernac_instance abst locality poly sup inst props pri =
 let vernac_context poly l =
   if not (Classes.context poly l) then Feedback.feedback Feedback.AddedAxiom
 
-let vernac_declare_instances locality ids pri =
+let vernac_declare_instances locality insts =
   let glob = not (make_section_locality locality) in
-  List.iter (fun id -> Classes.existing_instance glob id pri) ids
+  List.iter (fun (id, info) -> Classes.existing_instance glob id (Some info)) insts
 
 let vernac_declare_class id =
   Record.declare_existing_class (Nametab.global id)
@@ -835,23 +860,23 @@ let focus_command_cond = Proof.no_cond command_focus
 let vernac_solve_existential = instantiate_nth_evar_com
 
 let vernac_set_end_tac tac =
+  let open Genintern in
+  let env = { genv = Global.env (); ltacvars = Id.Set.empty } in
+  let _, tac = Genintern.generic_intern env tac in
   if not (refining ()) then
     error "Unknown command of the non proof-editing mode.";
-  match tac with
-  | Tacexpr.TacId [] -> ()
-  | _ -> set_end_tac tac
+  set_end_tac tac
     (* TO DO verifier s'il faut pas mettre exist s | TacId s ici*)
 
 let vernac_set_used_variables e =
-  let open Context.Named.Declaration in
   let env = Global.env () in
   let tys =
     List.map snd (Proof.initial_goals (Proof_global.give_me_the_proof ())) in
   let l = Proof_using.process_expr env e tys in
   let vars = Environ.named_context env in
   List.iter (fun id -> 
-    if not (List.exists (Id.equal id % get_id) vars) then
-      errorlabstrm "vernac_set_used_variables"
+    if not (List.exists (NamedDecl.get_id %> Id.equal id) vars) then
+      user_err ~hdr:"vernac_set_used_variables"
         (str "Unknown variable: " ++ pr_id id))
     l;
   let _, to_clear = set_used_variables l in
@@ -872,7 +897,7 @@ let expand filename =
 let vernac_add_loadpath implicit pdir ldiropt =
   let pdir = expand pdir in
   let alias = Option.default Nameops.default_root_prefix ldiropt in
-  Mltop.add_rec_path ~unix_path:pdir ~coq_root:alias ~implicit
+  Mltop.add_rec_path Mltop.AddTopML ~unix_path:pdir ~coq_root:alias ~implicit
 
 let vernac_remove_loadpath path =
   Loadpath.remove_load_path (expand path)
@@ -891,7 +916,11 @@ let vernac_chdir = function
   | Some path ->
       begin
 	try Sys.chdir (expand path)
-	with Sys_error err -> Feedback.msg_warning (str "Cd failed: " ++ str err)
+	with Sys_error err ->
+	  (* Cd is typically used to control the output directory of
+	  extraction. A failed Cd could lead to overwriting .ml files
+	  so we make it an error. *)
+	  CErrors.error ("Cd failed: " ^ err)
       end;
       if_verbose Feedback.msg_info (str (Sys.getcwd()))
 
@@ -938,141 +967,265 @@ let vernac_declare_implicits locality r l =
       Impargs.declare_manual_implicits local (smart_global r) ~enriching:false
 	(List.map (List.map (fun (ex,b,f) -> ex, (b,true,f))) imps)
 
-let vernac_declare_arguments locality r l nargs flags =
-  let extra_scope_flag = List.mem `ExtraScopes flags in
-  let names = List.map (List.map (fun (id, _,_,_,_) -> id)) l in
-  let names, rest = List.hd names, List.tl names in
-  let scopes = List.map (List.map (fun (_,_, s, _,_) -> s)) l in
-  if List.exists (fun na -> not (List.equal Name.equal na names)) rest then
-    error "All arguments lists must declare the same names.";
-  if not (List.distinct_f Name.compare (List.filter ((!=) Anonymous) names))
-  then error "Arguments names must be distinct.";
-  let sr = smart_global r in
+let warn_arguments_assert =
+  CWarnings.create ~name:"arguments-assert" ~category:"vernacular"
+         (fun sr ->
+          strbrk "This command is just asserting the names of arguments of " ++
+            pr_global sr ++ strbrk". If this is what you want add " ++
+            strbrk "': assert' to silence the warning. If you want " ++
+            strbrk "to clear implicit arguments add ': clear implicits'. " ++
+            strbrk "If you want to clear notation scopes add ': clear scopes'")
+
+(* [nargs_for_red] is the number of arguments required to trigger reduction,
+   [args] is the main list of arguments statuses,
+   [more_implicits] is a list of extra lists of implicit statuses  *)
+let vernac_arguments locality reference args more_implicits nargs_for_red flags =
+  let assert_flag = List.mem `Assert flags in
+  let rename_flag = List.mem `Rename flags in
+  let clear_scopes_flag = List.mem `ClearScopes flags in
+  let extra_scopes_flag = List.mem `ExtraScopes flags in
+  let clear_implicits_flag = List.mem `ClearImplicits flags in
+  let default_implicits_flag = List.mem `DefaultImplicits flags in
+  let never_unfold_flag = List.mem `ReductionNeverUnfold flags in
+
+  let err_incompat x y =
+    error ("Options \""^x^"\" and \""^y^"\" are incompatible.") in
+
+  if assert_flag && rename_flag then
+    err_incompat "assert" "rename";
+  if Option.has_some nargs_for_red && never_unfold_flag then
+    err_incompat "simpl never" "/";
+  if never_unfold_flag && List.mem `ReductionDontExposeCase flags then
+    err_incompat "simpl never" "simpl nomatch";
+  if clear_scopes_flag && extra_scopes_flag then
+    err_incompat "clear scopes" "extra scopes";
+  if clear_implicits_flag && default_implicits_flag then
+    err_incompat "clear implicits" "default implicits";
+
+  let sr = smart_global reference in
   let inf_names =
     let ty = Global.type_of_global_unsafe sr in
-      Impargs.compute_implicits_names (Global.env ()) ty in
-  let rec check li ld ls = match li, ld, ls with
-    | [], [], [] -> ()
-    | [], Anonymous::ld, (Some _)::ls when extra_scope_flag -> check li ld ls
-    | [], _::_, (Some _)::ls when extra_scope_flag ->
-       error "Extra notation scopes can be set on anonymous arguments only"
-    | [], x::_, _ -> errorlabstrm "vernac_declare_arguments"
-                       (str "Extra argument " ++ pr_name x ++ str ".")
-    | l, [], _ -> errorlabstrm "vernac_declare_arguments"
-                    (str "The following arguments are not declared: " ++
-                       prlist_with_sep pr_comma pr_name l ++ str ".")
-    | _::li, _::ld, _::ls -> check li ld ls 
-    | _ -> assert false in
-  let () = match l with
-  | [[]] -> ()
-  | _ ->
-    List.iter2 (fun l -> check inf_names l) (names :: rest) scopes
+    Impargs.compute_implicits_names (Global.env ()) ty
   in
-  (* we take extra scopes apart, and we check they are consistent *)
-  let l, scopes = 
-    let scopes, rest = List.hd scopes, List.tl scopes in
-    if List.exists (List.exists ((!=) None)) rest then
-      error "Notation scopes can be given only once";
-    if not extra_scope_flag then l, scopes else
-    let l, _ = List.split (List.map (List.chop (List.length inf_names)) l) in
-    l, scopes in
-  (* we interpret _ as the inferred names *)
-  let l = match l with
-  | [[]] -> l
-  | _ ->
-    let name_anons = function
-      | (Anonymous, a,b,c,d), Name id -> Name id, a,b,c,d
-      | x, _ -> x in
-    List.map (fun ns -> List.map name_anons (List.combine ns inf_names)) l in
-  let names_decl = List.map (List.map (fun (id, _,_,_,_) -> id)) l in
-  let renamed_arg = ref None in
-  let set_renamed a b =
-    if Option.is_empty !renamed_arg && not (Id.equal a b) then renamed_arg := Some(b,a) in
-  let some_renaming_specified =
-    try
-      let names = Arguments_renaming.arguments_names sr in
-      not (List.equal (List.equal Name.equal) names names_decl)
-    with Not_found -> false in
-  let some_renaming_specified, implicits =
-    match l with
-    | [[]] -> false, [[]]
+  let prev_names =
+    try Arguments_renaming.arguments_names sr with Not_found -> inf_names
+  in
+  let num_args = List.length inf_names in
+  assert (Int.equal num_args (List.length prev_names));
+
+  let names_of args = List.map (fun a -> a.name) args in
+
+  (* Checks *)
+
+  let err_extra_args names =
+    user_err ~hdr:"vernac_declare_arguments"
+                 (strbrk "Extra arguments: " ++
+                    prlist_with_sep pr_comma pr_name names ++ str ".")
+  in
+  let err_missing_args names =
+    user_err ~hdr:"vernac_declare_arguments"
+                 (strbrk "The following arguments are not declared: " ++
+                    prlist_with_sep pr_comma pr_name names ++ str ".")
+  in
+
+  let rec check_extra_args extra_args =
+    match extra_args with
+    | [] -> ()
+    | { notation_scope = None } :: _ -> err_extra_args (names_of extra_args)
+    | { name = Anonymous; notation_scope = Some _ } :: args ->
+       check_extra_args args
     | _ ->
-    List.fold_map (fun sr il ->
-      let sr', impl = List.fold_map (fun b -> function
-        | (Anonymous, _,_, true, max), Name id -> assert false
-        | (Name x, _,_, true, _), Anonymous ->
-            errorlabstrm "vernac_declare_arguments"
-              (str "Argument " ++ pr_id x ++ str " cannot be declared implicit.")
-        | (Name iid, _,_, true, max), Name id ->
-           set_renamed iid id;
-           b || not (Id.equal iid id), Some (ExplByName id, max, false)
-        | (Name iid, _,_, _, _), Name id ->
-           set_renamed iid id;
-           b || not (Id.equal iid id), None
-        | _ -> b, None)
-        sr (List.combine il inf_names) in
-      sr || sr', List.map_filter (fun x -> x) impl)
-      some_renaming_specified l in
-  if some_renaming_specified then
-    if not (List.mem `Rename flags) then
-      errorlabstrm "vernac_declare_arguments"
-        (str "To rename arguments the \"rename\" flag must be specified." ++
-           match !renamed_arg with
-           | None -> mt ()
-           | Some (o,n) ->
-              str "\nArgument " ++ pr_id o ++ str " renamed to " ++ pr_id n ++ str ".")
-    else
-      Arguments_renaming.rename_arguments
-        (make_section_locality locality) sr names_decl;
-  (* All other infos are in the first item of l *)
-  let l = List.hd l in
-  let some_implicits_specified = match implicits with
-  | [[]] -> false | _ -> true in
-  let scopes = List.map (function
-    | None -> None
-    | Some (o, k) ->
-        try ignore (Notation.find_scope k); Some k
-        with UserError _ ->
-          Some (Notation.find_delimiters_scope o k)) scopes
+       error "Extra notation scopes can be set on anonymous and explicit arguments only."
+  in
+
+  let args, scopes =
+    let scopes = List.map (fun { notation_scope = s } -> s) args in
+    if List.length args > num_args then
+      let args, extra_args = List.chop num_args args in
+      if extra_scopes_flag then
+        (check_extra_args extra_args; (args, scopes))
+      else err_extra_args (names_of extra_args)
+    else args, scopes
+  in
+
+  if Option.cata (fun n -> n > num_args) false nargs_for_red then
+    error "The \"/\" modifier should be put before any extra scope.";
+
+  let scopes_specified = List.exists Option.has_some scopes in
+  
+  if scopes_specified && clear_scopes_flag then
+    error "The \"clear scopes\" flag is incompatible with scope annotations.";
+
+  let names = List.map (fun { name } -> name) args in
+  let names = names :: List.map (List.map fst) more_implicits in
+
+  let rename_flag_required = ref false in
+  let example_renaming = ref None in
+  let save_example_renaming renaming =
+    rename_flag_required := !rename_flag_required
+                            || not (Name.equal (fst renaming) Anonymous);
+    if Option.is_empty !example_renaming then
+      example_renaming := Some renaming
+  in
+
+  let rec names_union names1 names2 =
+    match names1, names2 with
+    | [], [] -> []
+    | _ :: _, [] -> names1
+    | [], _ :: _ -> names2
+    | (Name _ as name) :: names1, Anonymous :: names2
+    | Anonymous :: names1, (Name _ as name) :: names2 ->
+       name :: names_union names1 names2
+    | name1 :: names1, name2 :: names2 ->
+       if Name.equal name1 name2 then
+         name1 :: names_union names1 names2
+       else error "Argument lists should agree on the names they provide."
+  in
+
+  let names = List.fold_left names_union [] names in
+
+  let rec rename prev_names names =
+    match prev_names, names with
+    | [], [] -> []
+    | [], _ :: _ -> err_extra_args names
+    | _ :: _, [] when assert_flag ->
+       (* Error messages are expressed in terms of original names, not
+            renamed ones. *)
+       err_missing_args (List.lastn (List.length prev_names) inf_names)
+    | _ :: _, [] -> prev_names
+    | prev :: prev_names, Anonymous :: names ->
+       prev :: rename prev_names names
+    | prev :: prev_names, (Name id as name) :: names ->
+       if not (Name.equal prev name) then save_example_renaming (prev,name);
+       name :: rename prev_names names
+  in
+  
+  let names = rename prev_names names in
+  let renaming_specified = Option.has_some !example_renaming in
+
+  if !rename_flag_required && not rename_flag then
+    user_err ~hdr:"vernac_declare_arguments"
+      (strbrk "To rename arguments the \"rename\" flag must be specified."
+    ++ spc () ++
+       match !example_renaming with
+       | None -> mt ()
+       | Some (o,n) ->
+          str "Argument " ++ pr_name o ++
+            str " renamed to " ++ pr_name n ++ str ".");
+
+  let duplicate_names =
+    List.duplicates Name.equal (List.filter ((!=) Anonymous) names)
   in
-  let some_scopes_specified = List.exists ((!=) None) scopes in
+  if not (List.is_empty duplicate_names) then begin
+    let duplicates = prlist_with_sep pr_comma pr_name duplicate_names in
+    user_err (strbrk "Some argument names are duplicated: " ++ duplicates)
+  end;
+
+  (* Parts of this code are overly complicated because the implicit arguments
+     API is completely crazy: positions (ExplByPos) are elaborated to
+     names. This is broken by design, since not all arguments have names. So
+     even though we eventually want to map only positions to implicit statuses,
+     we have to check whether the corresponding arguments have names, not to
+     trigger an error in the impargs code. Even better, the names we have to
+     check are not the current ones (after previous renamings), but the original
+     ones (inferred from the type). *)
+
+  let implicits =
+    List.map (fun { name; implicit_status = i } -> (name,i)) args
+  in
+  let implicits = implicits :: more_implicits in
+
+  let open Vernacexpr in
+  let rec build_implicits inf_names implicits =
+    match inf_names, implicits with
+    | _, [] -> []
+    | _ :: inf_names, (_, NotImplicit) :: implicits ->
+       build_implicits inf_names implicits
+
+    (* With the current impargs API, it is impossible to make an originally
+       anonymous argument implicit *)
+    | Anonymous :: _, (name, _) :: _ ->
+       user_err ~hdr:"vernac_declare_arguments"
+                    (strbrk"Argument "++ pr_name name ++ 
+                       strbrk " cannot be declared implicit.")
+
+    | Name id :: inf_names, (name, impl) :: implicits ->
+       let max = impl = MaximallyImplicit in
+       (ExplByName id,max,false) :: build_implicits inf_names implicits
+    
+    | _ -> assert false (* already checked in [names_union] *)
+  in
+  
+  let implicits = List.map (build_implicits inf_names) implicits in
+  let implicits_specified = match implicits with [[]] -> false | _ -> true in
+
+  if implicits_specified && clear_implicits_flag then
+    error "The \"clear implicits\" flag is incompatible with implicit annotations";
+
+  if implicits_specified && default_implicits_flag then
+    error "The \"default implicits\" flag is incompatible with implicit annotations";
+
   let rargs =
     Util.List.map_filter (function (n, true) -> Some n | _ -> None)
-      (Util.List.map_i (fun i (_, b, _,_,_) -> i, b) 0 l) in
-  if some_scopes_specified || List.mem `ClearScopes flags then
-    vernac_arguments_scope locality r scopes;
-  if not some_implicits_specified && List.mem `DefaultImplicits flags then
-    vernac_declare_implicits locality r []
-  else if some_implicits_specified || List.mem `ClearImplicits flags then
-    vernac_declare_implicits locality r implicits;
-  if nargs >= 0 && nargs < List.fold_left max 0 rargs then
-    error "The \"/\" option must be placed after the last \"!\".";
-  let no_flags = List.is_empty flags in
+      (Util.List.map_i (fun i { recarg_like = b } -> i, b) 0 args)
+  in
+
   let rec narrow = function
     | #Reductionops.ReductionBehaviour.flag as x :: tl -> x :: narrow tl
-    | [] -> [] | _ :: tl -> narrow tl in
-  let flags = narrow flags in
-  let some_simpl_flags_specified =
-    not (List.is_empty rargs) || nargs >= 0 || not (List.is_empty flags) in
-  if some_simpl_flags_specified then begin
+    | [] -> [] | _ :: tl -> narrow tl
+  in
+  let red_flags = narrow flags in
+  let red_modifiers_specified =
+    not (List.is_empty rargs) || Option.has_some nargs_for_red
+    || not (List.is_empty red_flags)
+  in
+
+  if not (List.is_empty rargs) && never_unfold_flag then
+    err_incompat "simpl never" "!";
+
+
+  (* Actions *)
+
+  if renaming_specified then begin
+    let local = make_section_locality locality in
+    Arguments_renaming.rename_arguments local sr names
+  end;
+
+  if scopes_specified || clear_scopes_flag then begin
+      let scopes = List.map (Option.map (fun (o,k) -> 
+        try ignore (Notation.find_scope k); k
+        with UserError _ ->
+          Notation.find_delimiters_scope o k)) scopes
+      in
+      vernac_arguments_scope locality reference scopes
+    end;
+
+  if implicits_specified || clear_implicits_flag then
+    vernac_declare_implicits locality reference implicits;
+
+  if default_implicits_flag then
+    vernac_declare_implicits locality reference [];
+
+  if red_modifiers_specified then begin
     match sr with
     | ConstRef _ as c ->
        Reductionops.ReductionBehaviour.set
-         (make_section_locality locality) c (rargs, nargs, flags)
-    | _ -> errorlabstrm "" (strbrk "Modifiers of the behavior of the simpl tactic are relevant for constants only.")
+         (make_section_locality locality) c
+         (rargs, Option.default ~-1 nargs_for_red, red_flags)
+    | _ -> user_err
+             (strbrk "Modifiers of the behavior of the simpl tactic "++
+              strbrk "are relevant for constants only.")
   end;
-  if not (some_renaming_specified ||
-          some_implicits_specified ||
-          some_scopes_specified ||
-          some_simpl_flags_specified) &&
-     no_flags then
-    Feedback.msg_warning (strbrk "This command is just asserting the number and names of arguments of " ++ pr_global sr ++ strbrk". If this is what you want add ': assert' to silence the warning. If you want to clear implicit arguments add ': clear implicits'. If you want to clear notation scopes add ': clear scopes'")
 
+ if not (renaming_specified ||
+         implicits_specified ||
+         scopes_specified ||
+         red_modifiers_specified) && (List.is_empty flags) then
+    warn_arguments_assert sr
 
 let default_env () = {
   Notation_term.ninterp_var_type = Id.Map.empty;
   ninterp_rec_vars = Id.Map.empty;
-  ninterp_only_parse = false;
 }
 
 let vernac_reserve bl =
@@ -1081,7 +1234,7 @@ let vernac_reserve bl =
     let sigma = Evd.from_env env in
     let t,ctx = Constrintern.interp_type env sigma c in
     let t = Detyping.detype false [] env (Evd.from_ctx ctx) t in
-    let t = Notation_ops.notation_constr_of_glob_constr (default_env ()) t in
+    let t,_ = Notation_ops.notation_constr_of_glob_constr (default_env ()) t in
     Reserve.declare_reserved_type idl t)
   in List.iter sb_decl bl
 
@@ -1268,8 +1421,8 @@ let _ =
       optdepr  = false;
       optname  = "kernel term sharing";
       optkey   = ["Kernel"; "Term"; "Sharing"];
-      optread  = (fun () -> !Closure.share);
-      optwrite = (fun b -> Closure.share := b) }
+      optread  = (fun () -> !CClosure.share);
+      optwrite = (fun b -> CClosure.share := b) }
 
 (* No more undo limit in the new proof engine.
    The command still exists for compatibility (e.g. with ProofGeneral) *)
@@ -1337,6 +1490,15 @@ let _ =
       optread  = (fun () -> !Constrintern.parsing_explicit);
       optwrite = (fun b ->  Constrintern.parsing_explicit := b) }
 
+let _ =
+  declare_string_option ~preprocess:CWarnings.normalize_flags_string
+    { optsync  = true;
+      optdepr  = false;
+      optname  = "warnings display";
+      optkey   = ["Warnings"];
+      optread  = CWarnings.get_flags;
+      optwrite = CWarnings.set_flags }
+
 let vernac_set_strategy locality l =
   let local = make_locality locality in
   let glob_ref r =
@@ -1366,6 +1528,9 @@ let vernac_set_option locality key = function
   | IntValue n -> set_int_option_value_gen locality key n
   | BoolValue b -> set_bool_option_value_gen locality key b
 
+let vernac_set_append_option locality key s =
+  set_string_option_append_value_gen locality key s
+
 let vernac_unset_option locality key =
   unset_option_value_gen locality key
 
@@ -1405,7 +1570,7 @@ let get_current_context_of_args = function
 let vernac_check_may_eval redexp glopt rc =
   let (sigma, env) = get_current_context_of_args glopt in
   let sigma', c = interp_open_constr env sigma rc in
-  let sigma' = Evarconv.consider_remaining_unif_problems env sigma' in
+  let sigma' = Evarconv.solve_unif_constraints_with_heuristics env sigma' in
   Evarconv.check_problems_are_solved env sigma';
   let sigma',nf = Evarutil.nf_evars_and_universes sigma' in
   let pl, uctx = Evd.universe_context sigma' in
@@ -1471,7 +1636,7 @@ let print_about_hyp_globs ref_or_by_not glnumopt =
       | Some n,AN (Ident (_loc,id)) ->  (* goal number given, catch if wong *)
 	 (try get_nth_goal n,id
 	  with
-	    Failure _ -> errorlabstrm "print_about_hyp_globs"
+	    Failure _ -> user_err ~hdr:"print_about_hyp_globs"
                            (str "No such goal: " ++ int n ++ str "."))
       | _ , _ -> raise NoHyp in
     let hyps = pf_hyps gl in
@@ -1479,7 +1644,7 @@ let print_about_hyp_globs ref_or_by_not glnumopt =
     let natureofid = match decl with
                      | LocalAssum _ -> "Hypothesis"
                      | LocalDef (_,bdy,_) ->"Constant (let in)" in
-    v 0 (pr_id id ++ str":" ++ pr_constr (get_type decl) ++ fnl() ++ fnl()
+    v 0 (pr_id id ++ str":" ++ pr_constr (NamedDecl.get_type decl) ++ fnl() ++ fnl()
 	 ++ str natureofid ++ str " of the goal context.")
   with (* fallback to globals *)
     | NoHyp | Not_found -> print_about ref_or_by_not
@@ -1547,8 +1712,8 @@ let global_module r =
   let (loc,qid) = qualid_of_reference r in
   try Nametab.full_name_module qid
   with Not_found ->
-    user_err_loc (loc, "global_module",
-      str "Module/section " ++ pr_qualid qid ++ str " not found.")
+    user_err ~loc ~hdr:"global_module"
+     (str "Module/section " ++ pr_qualid qid ++ str " not found.")
 
 let interp_search_restriction = function
   | SearchOutside l -> (List.map global_module l, true)
@@ -1570,9 +1735,31 @@ let interp_search_about_item env =
 	    (fun _ -> true) s sc in
 	GlobSearchSubPattern (Pattern.PRef ref)
       with UserError _ ->
-	errorlabstrm "interp_search_about_item"
+	user_err ~hdr:"interp_search_about_item"
           (str "Unable to interp \"" ++ str s ++ str "\" either as a reference or as an identifier component")
 
+(* 05f22a5d6d5b8e3e80f1a37321708ce401834430 introduced the
+   `search_output_name_only` option to avoid excessive printing when
+   searching.
+
+   The motivation was to make search usable for IDE completion,
+   however, it is still too slow due to the non-indexed nature of the
+   underlying search mechanism.
+
+   In the future we should deprecate the option and provide a fast,
+   indexed name-searching interface.
+*)
+let search_output_name_only = ref false
+
+let _ =
+  declare_bool_option
+    { optsync  = true;
+      optdepr  = false;
+      optname  = "output-name-only search";
+      optkey   = ["Search";"Output";"Name";"Only"];
+      optread  = (fun () -> !search_output_name_only);
+      optwrite = (:=) search_output_name_only }
+
 let vernac_search s gopt r =
   let r = interp_search_restriction r in
   let env,gopt =
@@ -1584,16 +1771,25 @@ let vernac_search s gopt r =
     | Some g -> snd (Pfedit.get_goal_context g) , Some g
   in
   let get_pattern c = snd (intern_constr_pattern env c) in
-  let open Feedback in
+  let pr_search ref env c =
+    let pr = pr_global ref in
+    let pp = if !search_output_name_only
+      then pr
+      else begin
+        let pc = pr_lconstr_env env Evd.empty c in
+        hov 2 (pr ++ str":" ++ spc () ++ pc)
+      end
+    in Feedback.msg_notice pp
+  in
   match s with
   | SearchPattern c ->
-      msg_notice (Search.search_pattern gopt (get_pattern c) r)
+      (Search.search_pattern gopt (get_pattern c) r |> Search.prioritize_search) pr_search
   | SearchRewrite c ->
-      msg_notice (Search.search_rewrite gopt (get_pattern c) r)
+      (Search.search_rewrite gopt (get_pattern c) r |> Search.prioritize_search) pr_search
   | SearchHead c ->
-      msg_notice (Search.search_by_head gopt (get_pattern c) r)
+      (Search.search_by_head gopt (get_pattern c) r |> Search.prioritize_search) pr_search
   | SearchAbout sl ->
-     msg_notice (Search.search_about gopt (List.map (on_snd (interp_search_about_item env)) sl) r)
+      (Search.search_about gopt (List.map (on_snd (interp_search_about_item env)) sl) r |> Search.prioritize_search) pr_search
 
 let vernac_locate = let open Feedback in function
   | LocateAny (AN qid)  -> msg_notice (print_located_qualid qid)
@@ -1626,7 +1822,7 @@ let vernac_focus gln =
     match gln with
       | None -> Proof.focus focus_command_cond () 1 p
       | Some 0 ->
-         Errors.error "Invalid goal number: 0. Goal numbering starts with 1."
+         CErrors.error "Invalid goal number: 0. Goal numbering starts with 1."
       | Some n ->
          Proof.focus focus_command_cond () n p)
 
@@ -1668,6 +1864,7 @@ let vernac_bullet (bullet:Proof_global.Bullet.t) =
     Proof_global.Bullet.put p bullet)
 
 let vernac_show = let open Feedback in function
+  | ShowScript -> assert false  (* Only the stm knows the script *)
   | ShowGoal goalref ->
     let info = match goalref with
       | OpenSubgoals -> pr_open_subgoals ()
@@ -1682,7 +1879,6 @@ let vernac_show = let open Feedback in function
       Constrextern.with_implicits msg_notice (pr_nth_open_subgoal n)
   | ShowProof -> show_proof ()
   | ShowNode -> show_node ()
-  | ShowScript -> Stm.show_script ()
   | ShowExistentials -> show_top_evars ()
   | ShowUniverses -> show_universes ()
   | ShowTree -> show_prooftree ()
@@ -1709,7 +1905,17 @@ let vernac_check_guard () =
 
 exception End_of_input
 
+(* XXX: This won't properly set the proof mode, as of today, it is
+   controlled by the STM. Thus, we would need access information from
+   the classifier. The proper fix is to move it to the STM, however,
+   the way the proof mode is set there makes the task non trivial
+   without a considerable amount of refactoring.
+ *)
 let vernac_load interp fname =
+  let interp x =
+    let proof_mode = Proof_global.get_default_proof_mode_name () in
+    Proof_global.activate_proof_mode proof_mode;
+    interp x in
   let parse_sentence = Flags.with_option Flags.we_are_parsing
     (fun po ->
     match Pcoq.Gram.entry_parse Pcoq.main_entry po with
@@ -1721,11 +1927,10 @@ let vernac_load interp fname =
   let input =
     let longfname = Loadpath.locate_file fname in
     let in_chan = open_utf8_file_in longfname in
-    Pcoq.Gram.parsable (Stream.of_channel in_chan) in
+    Pcoq.Gram.parsable ~file:longfname (Stream.of_channel in_chan) in
   try while true do interp (snd (parse_sentence input)) done
   with End_of_input -> ()
 
-
 (* "locality" is the prefix "Local" attribute, while the "local" component
  * is the outdated/deprecated "Local" attribute of some vernacular commands
  * still parsed as the obsolete_locality grammar entry for retrocompatibility.
@@ -1733,16 +1938,45 @@ let vernac_load interp fname =
 let interp ?proof ~loc locality poly c =
   prerr_endline (fun () -> "interpreting: " ^ Pp.string_of_ppcmds (Ppvernac.pr_vernac c));
   match c with
-  (* Done later in this file *)
+  (* The below vernac are candidates for removal from the main type
+     and to be put into a new doc_command datatype: *)
+
   | VernacLoad _ -> assert false
+
+  (* Done later in this file *)
   | VernacFail _ -> assert false
   | VernacTime _ -> assert false
   | VernacRedirect _ -> assert false
   | VernacTimeout _ -> assert false
   | VernacStm _ -> assert false
 
+  (* The STM should handle that, but LOAD bypasses the STM... *)
+  | VernacAbortAll    -> CErrors.user_err  (str "AbortAll cannot be used through the Load command")
+  | VernacRestart     -> CErrors.user_err  (str "Restart cannot be used through the Load command")
+  | VernacUndo _      -> CErrors.user_err  (str "Undo cannot be used through the Load command")
+  | VernacUndoTo _    -> CErrors.user_err  (str "UndoTo cannot be used through the Load command")
+  | VernacBacktrack _ -> CErrors.user_err  (str "Backtrack cannot be used through the Load command")
+
+  (* Toplevel control *)
+  | VernacToplevelControl e -> raise e
+
+  (* Resetting *)
+  | VernacResetName _  -> anomaly (str "VernacResetName not handled by Stm")
+  | VernacResetInitial -> anomaly (str "VernacResetInitial not handled by Stm")
+  | VernacBack _       -> anomaly (str "VernacBack not handled by Stm")
+  | VernacBackTo _     -> anomaly (str "VernacBackTo not handled by Stm")
+
+  (* Horrible Hack that should die. *)
   | VernacError e -> raise e
 
+  (* This one is possible to handle here *)
+  | VernacAbort id    -> CErrors.user_err  (str "Abort cannot be used through the Load command")
+
+  (* Handled elsewhere *)
+  | VernacProgram _
+  | VernacPolymorphic _
+  | VernacLocal _ -> assert false
+
   (* Syntax *)
   | VernacSyntaxExtension (local,sl) ->
       vernac_syntax_extension locality local sl
@@ -1794,10 +2028,10 @@ let interp ?proof ~loc locality poly c =
       vernac_identity_coercion locality poly local id s t
 
   (* Type classes *)
-  | VernacInstance (abst, sup, inst, props, pri) ->
-      vernac_instance abst locality poly sup inst props pri
+  | VernacInstance (abst, sup, inst, props, info) ->
+      vernac_instance abst locality poly sup inst props info
   | VernacContext sup -> vernac_context poly sup
-  | VernacDeclareInstances (ids, pri) -> vernac_declare_instances locality ids pri
+  | VernacDeclareInstances insts -> vernac_declare_instances locality insts
   | VernacDeclareClass id -> vernac_declare_class id
 
   (* Solving *)
@@ -1814,12 +2048,6 @@ let interp ?proof ~loc locality poly c =
   | VernacWriteState s -> vernac_write_state s
   | VernacRestoreState s -> vernac_restore_state s
 
-  (* Resetting *)
-  | VernacResetName _ -> anomaly (str "VernacResetName not handled by Stm")
-  | VernacResetInitial -> anomaly (str "VernacResetInitial not handled by Stm")
-  | VernacBack _ -> anomaly (str "VernacBack not handled by Stm")
-  | VernacBackTo _ -> anomaly (str "VernacBackTo not handled by Stm")
-
   (* Commands *)
   | VernacCreateHintDb (dbname,b) -> vernac_create_hintdb locality dbname b
   | VernacRemoveHints (dbnames,ids) -> vernac_remove_hints locality dbnames ids
@@ -1829,13 +2057,14 @@ let interp ?proof ~loc locality poly c =
       vernac_syntactic_definition locality  id c local b
   | VernacDeclareImplicits (qid,l) ->
       vernac_declare_implicits locality qid l
-  | VernacArguments (qid, l, narg, flags) ->
-      vernac_declare_arguments locality qid l narg flags 
+  | VernacArguments (qid, args, more_implicits, nargs, flags) ->
+      vernac_arguments locality qid args more_implicits nargs flags
   | VernacReserve bl -> vernac_reserve bl
   | VernacGeneralizable gen -> vernac_generalizable locality gen
   | VernacSetOpacity qidl -> vernac_set_opacity locality qidl
   | VernacSetStrategy l -> vernac_set_strategy locality l
   | VernacSetOption (key,v) -> vernac_set_option locality key v
+  | VernacSetAppendOption (key,v) -> vernac_set_append_option locality key v
   | VernacUnsetOption key -> vernac_unset_option locality key
   | VernacRemoveOption (key,v) -> vernac_remove_option key v
   | VernacAddOption (key,v) -> vernac_add_option key v
@@ -1850,14 +2079,6 @@ let interp ?proof ~loc locality poly c =
   | VernacRegister (id, r) -> vernac_register id r
   | VernacComments l -> if_verbose Feedback.msg_info (str "Comments ok\n")
 
-  (* The STM should handle that, but LOAD bypasses the STM... *)
-  | VernacAbort id -> Feedback.msg_warning (str "VernacAbort not handled by Stm")
-  | VernacAbortAll -> Feedback.msg_warning (str "VernacAbortAll not handled by Stm")
-  | VernacRestart -> Feedback.msg_warning (str "VernacRestart not handled by Stm")
-  | VernacUndo _ -> Feedback.msg_warning (str "VernacUndo not handled by Stm")
-  | VernacUndoTo _ -> Feedback.msg_warning (str "VernacUndoTo not handled by Stm")
-  | VernacBacktrack _ -> Feedback.msg_warning (str "VernacBacktrack not handled by Stm")
-  
   (* Proof management *)
   | VernacGoal t -> vernac_start_proof locality poly Theorem [None,([],t,None)] false
   | VernacFocus n -> vernac_focus n
@@ -1880,17 +2101,10 @@ let interp ?proof ~loc locality poly c =
       Aux_file.record_in_aux_at loc "VernacProof" "tac:yes using:yes";
       vernac_set_end_tac tac; vernac_set_used_variables l
   | VernacProofMode mn -> Proof_global.set_proof_mode mn
-  (* Toplevel control *)
-  | VernacToplevelControl e -> raise e
 
   (* Extensions *)
   | VernacExtend (opn,args) -> Vernacinterp.call ?locality (opn,args)
 
-  (* Handled elsewhere *)
-  | VernacProgram _
-  | VernacPolymorphic _
-  | VernacLocal _ -> assert false
-
 (* Vernaculars that take a locality flag *)
 let check_vernac_supports_locality c l =
   match l, c with
@@ -1908,11 +2122,11 @@ let check_vernac_supports_locality c l =
     | VernacArgumentsScope _ | VernacDeclareImplicits _ | VernacArguments _
     | VernacGeneralizable _
     | VernacSetOpacity _ | VernacSetStrategy _
-    | VernacSetOption _ | VernacUnsetOption _
+    | VernacSetOption _ | VernacSetAppendOption _ | VernacUnsetOption _
     | VernacDeclareReduction _
     | VernacExtend _ 
     | VernacInductive _) -> ()
-  | Some _, _ -> Errors.error "This command does not support Locality"
+  | Some _, _ -> CErrors.error "This command does not support Locality"
 
 (* Vernaculars that take a polymorphism flag *)
 let check_vernac_supports_polymorphism c p =
@@ -1926,13 +2140,13 @@ let check_vernac_supports_polymorphism c p =
     | VernacInstance _ | VernacDeclareInstances _
     | VernacHints _ | VernacContext _
     | VernacExtend _ | VernacUniverse _ | VernacConstraint _) -> ()
-  | Some _, _ -> Errors.error "This command does not support Polymorphism"
+  | Some _, _ -> CErrors.error "This command does not support Polymorphism"
 
 let enforce_polymorphism = function
   | None -> Flags.is_universe_polymorphism ()
   | Some b -> Flags.make_polymorphic_flag b; b
 
-(** A global default timeout, controled by option "Set Default Timeout n".
+(** A global default timeout, controlled by option "Set Default Timeout n".
     Use "Unset Default Timeout" to deactivate it (or set it to 0). *)
 
 let default_timeout = ref None
@@ -1980,15 +2194,15 @@ let with_fail b f =
            with
            | HasNotFailed as e -> raise e
            | e ->
-              let e = Errors.push e in
-              raise (HasFailed (Errors.iprint
-                (Cerrors.process_vernac_interp_error ~allow_uncaught:false ~with_header:false e))))
+              let e = CErrors.push e in
+              raise (HasFailed (CErrors.iprint
+                (ExplainErr.process_vernac_interp_error ~allow_uncaught:false ~with_header:false e))))
         ()
-    with e when Errors.noncritical e -> 
-      let (e, _) = Errors.push e in
+    with e when CErrors.noncritical e ->
+      let (e, _) = CErrors.push e in
       match e with
       | HasNotFailed ->
-          errorlabstrm "Fail" (str "The command has not failed!")
+          user_err ~hdr:"Fail" (str "The command has not failed!")
       | HasFailed msg ->
           if is_verbose () || !test_mode || !ide_slave then Feedback.msg_info
             (str "The command has indeed failed with message:" ++ fnl () ++ msg)
@@ -1999,13 +2213,13 @@ let interp ?(verbosely=true) ?proof (loc,c) =
   let orig_program_mode = Flags.is_program_mode () in
   let rec aux ?locality ?polymorphism isprogcmd = function
     | VernacProgram c when not isprogcmd -> aux ?locality ?polymorphism true c
-    | VernacProgram _ -> Errors.error "Program mode specified twice"
+    | VernacProgram _ -> CErrors.error "Program mode specified twice"
     | VernacLocal (b, c) when Option.is_empty locality -> 
       aux ~locality:b ?polymorphism isprogcmd c
     | VernacPolymorphic (b, c) when polymorphism = None -> 
       aux ?locality ~polymorphism:b isprogcmd c
-    | VernacPolymorphic (b, c) -> Errors.error "Polymorphism specified twice"
-    | VernacLocal _ -> Errors.error "Locality specified twice"
+    | VernacPolymorphic (b, c) -> CErrors.error "Polymorphism specified twice"
+    | VernacLocal _ -> CErrors.error "Locality specified twice"
     | VernacStm (Command c) -> aux ?locality ?polymorphism isprogcmd c
     | VernacStm (PGLast c) -> aux ?locality ?polymorphism isprogcmd c
     | VernacStm _ -> assert false (* Done by Stm *)
@@ -2038,9 +2252,9 @@ let interp ?(verbosely=true) ?proof (loc,c) =
         | reraise when
               (match reraise with
               | Timeout -> true
-              | e -> Errors.noncritical e)
+              | e -> CErrors.noncritical e)
           ->
-            let e = Errors.push reraise in
+            let e = CErrors.push reraise in
             let e = locate_if_not_already loc e in
             let () = restore_timeout () in
             Flags.program_mode := orig_program_mode;
@@ -2049,6 +2263,3 @@ let interp ?(verbosely=true) ?proof (loc,c) =
   in
     if verbosely then Flags.verbosely (aux false) c
     else aux false c
-
-let () = Hook.set Stm.interp_hook interp
-let () = Hook.set Stm.with_fail_hook with_fail
diff --git a/toplevel/vernacentries.mli b/vernac/vernacentries.mli
index 4e7fa4a08..7cdc8dd06 100644
--- a/toplevel/vernacentries.mli
+++ b/vernac/vernacentries.mli
@@ -62,5 +62,5 @@ val with_fail : bool -> (unit -> unit) -> unit
 
 val command_focus : unit Proof.focus_kind
 
-val interp_redexp_hook : (Environ.env -> Evd.evar_map -> Tacexpr.raw_red_expr ->
+val interp_redexp_hook : (Environ.env -> Evd.evar_map -> Genredexpr.raw_red_expr ->
   Evd.evar_map * Redexpr.red_expr) Hook.t
diff --git a/toplevel/vernacinterp.ml b/vernac/vernacinterp.ml
index 1116a3104..f26ef460d 100644
--- a/toplevel/vernacinterp.ml
+++ b/vernac/vernacinterp.ml
@@ -8,7 +8,7 @@
 
 open Util
 open Pp
-open Errors
+open CErrors
 
 type deprecation = bool
 type vernac_command = Genarg.raw_generic_argument list -> unit -> unit
@@ -22,7 +22,7 @@ let vinterp_add depr s f =
   try
     Hashtbl.add vernac_tab s (depr, f)
   with Failure _ ->
-    errorlabstrm "vinterp_add"
+    user_err ~hdr:"vinterp_add"
       (str"Cannot add the vernac command " ++ str (fst s) ++ str" twice.")
 
 let overwriting_vinterp_add s f =
@@ -37,11 +37,16 @@ let vinterp_map s =
   try
     Hashtbl.find vernac_tab s
   with Failure _ | Not_found ->
-    errorlabstrm "Vernac Interpreter"
+    user_err ~hdr:"Vernac Interpreter"
       (str"Cannot find vernac command " ++ str (fst s) ++ str".")
 
 let vinterp_init () = Hashtbl.clear vernac_tab
 
+let warn_deprecated_command =
+  let open CWarnings in
+  create ~name:"deprecated-command" ~category:"deprecated"
+         (fun pr -> str "Deprecated vernacular command: " ++ pr)
+
 (* Interpretation of a vernac command *)
 
 let call ?locality (opn,converted_args) =
@@ -55,7 +60,7 @@ let call ?locality (opn,converted_args) =
       | Egramml.GramNonTerminal _ -> str "_"
       in
       let pr = pr_sequence pr_gram rules in
-      Feedback.msg_warning (str "Deprecated vernacular command: " ++ pr)
+      warn_deprecated_command pr;
     in
     loc:= "Checking arguments";
     let hunk = callback converted_args in
@@ -66,7 +71,7 @@ let call ?locality (opn,converted_args) =
   with
     | Drop -> raise Drop
     | reraise ->
-        let reraise = Errors.push reraise in
+        let reraise = CErrors.push reraise in
         if !Flags.debug then
 	  Feedback.msg_debug (str"Vernac Interpreter " ++ str !loc);
         iraise reraise
diff --git a/toplevel/vernacinterp.mli b/vernac/vernacinterp.mli
index 5149b5416..5149b5416 100644
--- a/toplevel/vernacinterp.mli
+++ b/vernac/vernacinterp.mli